suavizar.serie <- function(datos, fechas = NULL, n = 5, type = "centrado") {
  if(!"data.frame" %in% class(datos)) datos <- data.frame(datos)
  if(is.null(fechas)) fechas <- row.names(datos)
  
  if(type == "centrado") {
    cant <- ceiling(n/2)
    for (i in 1:(cant-1)) datos <- rbind(NA, datos, NA)
  } else if(type == "derecha") {
    cant <- 1
    for (i in 1:(n - 1)) datos <- rbind(datos, NA)
  } else if(type == "izquierda") {
    if(any(is.na(datos[1, ]))) datos[1, ] <- apply(datos, 2, mean, na.rm = T)
    cant <- n
    for (i in 1:(n - 1)) datos <- rbind(NA, datos)
  } else {
    print("ERROR: el parámetro 'type' no es permitido")
    break()
  }
  
  datos <- rollapply(datos, n, function(i) i[cant] <- mean(i, na.rm = TRUE))
  
  datos <- data.frame(datos, row.names = as.character(fechas))
  return(datos)
}
imputar.serie <- function(datos, fechas , n , type = "center") {
  if(is.null(fechas)) {
    fechas <- row.names(datos)
  }
  
  if(type == "center") {
    cant <- ceiling(n/2)
    for (i in 1:(cant-1)) datos <- rbind(NA, datos, NA)
  } else if(type == "right") {
    cant <- 1
    for (i in 1:(n - 1)) datos <- rbind(datos, NA)
  } else if(type == "left") {
    if(any(is.na(datos[1, ]))) datos[1, ] <- apply(datos, 2, mean, na.rm = T)
    cant <- n
    for (i in 1:(n - 1)) datos <- rbind(NA, datos)
  } else {
    print("ERROR: el parámetro 'type' no es permitido")
    break()
  }
  
  
  datos <- rollapply(datos, n, function(i) 
    ifelse(is.na(i[cant]), mean(i, na.rm = TRUE), i[cant])
  )
  
  
  datos <- data.frame(datos, row.names = as.character(fechas))
  return(datos)
}
mi.tema <- theme_grey() + theme(panel.border = element_rect(fill = NA,color = "white"), plot.title = element_text(hjust = 0.5))
valor_nulo<-function(datos){
  
  h2o.no_progress()
  h2o.init(ip = "localhost",port = 54321,nthreads = -1, max_mem_size = "7g")
  datos<-as.h2o(datos)
  for(i in h2o.columns_by_type(datos,coltype = "numeric"))
    h2o.impute(datos, column=i, method = "mean")
  datos<-as.data.frame(datos)
  h2o.shutdown(prompt = TRUE)
  return(datos)
}

periodiograma<-function(datos_periodigrama,fecha){
  datos_periodigrama<-ts(rev(datos_periodigrama),start = c(yday(fecha),lubridate::day(fecha)),frequency = 365)
  res<-spec.pgram(datos_periodigrama)
  order(res$spec,res$freq,decreasing = TRUE)
  max<- vector(mode="numeric", length=0)
  periodo<-vector(mode="double", length=0)
  for (i in  1:length(res$freq)) {
    if (res$freq[i]!=1 && length(max)<3){
      max[i]<-res$freq[i]
      periodo[i]<-365/max[i]
      
    }
  }
  abline(v=max[1], lty="dotted",col="red")
  abline(v=max[2], lty="dotted",col="blue")
  abline(v=max[3], lty="dotted",col="black")
  return(list(res,periodo))
}
atipicidad<-function(tecnologia,dato,individuos_acp){
  for (i in 1:5) {
    if (tecnologia=="3G"){
      if(!is.na(individuos_acp[i])){

              # dato<-sqldf(sprintf("select `Fecha`,`Id.Celda`,avg(`Trafico.1`) as `Trafico.1`,avg(`Trafico.2`) as `Trafico.2` 
      #                    from datos_3g where `Id.Celda`= '%s' group by `Fecha`", as.character(individuos_acp$data$name[i])))
      
      dato<-sqldf(sprintf("select `Fecha`,`Id.Celda`,avg(`Trafico.1`) as `Trafico.1`,avg(`Trafico.2`) as `Trafico.2` 
                          from datos_3g where `Id.Celda`= '%s' group by `Fecha`", as.character(individuos_acp[i])))
      plot(diff(ts(rev(dato$Trafico.1),start = c(lubridate::year(dato$Fecha)[1],yday(dato$Fecha)[1]),frequency = 365),type="l"),ylab = "",main = paste("Atipicidad de variable Trafico.1 en la celda",as.character(individuos_acp[i]),sep = " "))
      plot(diff(ts(rev(dato$Trafico.2),start = c(lubridate::year(dato$Fecha)[1],yday(dato$Fecha)[1]),frequency = 365),type="l"),ylab = "",main = paste("Atipicidad de variable Trafico.2 en la celda",as.character(individuos_acp[i]),sep = " "))  
      }
    }else{
      if(!is.na(individuos_acp[i])){
      dato<-sqldf(sprintf("select `Fecha`,`Id.Celda`,avg(`Trafico2.carga`) as `Trafico2.carga`,avg(`Trafico2.Descarga`) as `Trafico2.Descarga` 
                          from datos_4g where `Id.Celda`= '%s' group by `Fecha`", as.character(individuos_acp[i])))
      plot(diff(ts(rev(dato$Trafico2.carga),start = c(lubridate::year(dato$Fecha)[1],yday(dato$Fecha)[1]),frequency = 365),type="l"),ylab = "",main = paste("Atipicidad de variable Trafico2.carga en la celda",as.character(individuos_acp[i]),sep = " "))
      plot(diff(ts(rev(dato$Trafico2.Descarga),start = c(lubridate::year(dato$Fecha)[1],yday(dato$Fecha)[1]),frequency = 365),type="l"),ylab = "",main = paste("Atipicidad de variable Trafico2,Descarga en la celda",as.character(individuos_acp[i]),sep = " "))        
      }
    }
  }
}
suavizado<-function(tecnologia,dato,individuos_acp){
  for(i in 1:5){
      if (tecnologia=="3G"){
        if (!is.na(individuos_acp[i])){
      dato<-sqldf(sprintf("select `Fecha`,`Id.Celda`,avg(`Trafico.1`) as `Trafico.1`,avg(`Trafico.2`) as `Trafico.2` 
                          from datos_3g where `Id.Celda`= '%s' group by `Fecha`", as.character(individuos_acp[i])))
      plot(diff(ts(rev(dato$Trafico.1),start = c(lubridate::year(dato$Fecha)[1],yday(dato$Fecha)[1]),frequency = 365),type="l"),ylab = "",main = paste("Antes:Suavizado de variable Trafico.1 en la celda",as.character(individuos_acp[i]),sep = " "))
      suavizado_dato<-stats::filter(dato$Trafico.1,filter=rep(1/5,5))
      plot(diff(ts(rev(suavizado_dato),start = c(lubridate::year(dato$Fecha)[1],yday(dato$Fecha)[1]),frequency = 365),type="l"),ylab = "",main = paste("Después:Suavizado de variable Trafico.1 en la celda",as.character(individuos_acp[i]),sep = " "))
      
      plot(diff(ts(rev(dato$Trafico.2),start = c(lubridate::year(dato$Fecha)[1],yday(dato$Fecha)[1]),frequency = 365),type="l"),ylab = "",main = paste("Antes:Suavizado de variable Trafico.2 en la celda",as.character(individuos_acp[i]),sep = " "))
      suavizado_dato<-stats::filter(dato$Trafico.2,filter=rep(1/5,5))
      plot(diff(ts(rev(suavizado_dato),start = c(lubridate::year(dato$Fecha)[1],yday(dato$Fecha)[1]),frequency = 365),type="l"),ylab = "",main = paste("Después:Suavizado de variable Trafico.2 en la celda",as.character(individuos_acp[i]),sep = " "))
      
    }
    }
    else{
      if(!is.na(individuos_acp[i])){
        dato<-sqldf(sprintf("select `Fecha`,`Id.Celda`,avg(`Trafico2.carga`) as `Trafico2.carga`,avg(`Trafico2.Descarga`) as `Trafico2.Descarga` 
                          from datos_4g where `Id.Celda`= '%s' group by `Fecha`", as.character(individuos_acp[i])))
      plot(diff(ts(rev(dato$Trafico2.carga),start = c(lubridate::year(dato$Fecha)[1],yday(dato$Fecha)[1]),frequency = 365),type="l"),ylab = "",main = paste("Antes:Suavizado de variable Trafico2.carga en la celda",as.character(individuos_acp[i]),sep = " "))
      suavizado_dato<-stats::filter(dato$Trafico2.carga,filter=rep(1/5,5))
      plot(diff(ts(rev(suavizado_dato),start = c(lubridate::year(dato$Fecha)[1],yday(dato$Fecha)[1]),frequency = 365),type="l"),ylab = "",main = paste("Después:Suavizado de variable Trafico2.carga en la celda",as.character(individuos_acp[i]),sep = " "))
      
      plot(diff(ts(rev(dato$Trafico2.Descarga),start = c(lubridate::year(dato$Fecha)[1],yday(dato$Fecha)[1]),frequency = 365),type="l"),ylab = "",main = paste("Antes:Suavizado de variable Trafico2.Descarga en la celda",as.character(individuos_acp[i]),sep = " "))
      suavizado_dato<-stats::filter(dato$Trafico2.Descarga,filter=rep(1/5,5))
      plot(diff(ts(rev(suavizado_dato),start = c(lubridate::year(dato$Fecha)[1],yday(dato$Fecha)[1]),frequency = 365),type="l"),ylab = "",main = paste("Después:Suavizado de variable Trafico2.Descarga en la celda",as.character(individuos_acp[i]),sep = " "))
      }
    }
  }
}
periodiograma<-function(tecnologia,datos_periodigrama,individuos_acp){
  for (i in 1:5) {
    if(tecnologia=="3G"){
      if(!is.na(individuos_acp[i])){
        dato<-sqldf(sprintf("select `Fecha`,`Id.Celda`,avg(`Trafico.1`) as `Trafico.1`,avg(`Trafico.2`) as `Trafico.2` 
                          from datos_3g where `Id.Celda`= '%s' group by `Fecha`", as.character(individuos_acp[i])))
      datos_periodigrama_3g_trafico_1<-ts(rev(dato$Trafico.1),start = c(lubridate::year(dato$Fecha)[1],yday(dato$Fecha)[1]),frequency = 365)
      res<-spec.pgram(datos_periodigrama_3g_trafico_1)
      order(res$spec,res$freq,decreasing = TRUE)
      max1<- vector(mode="numeric", length=0)
      periodo1<-vector(mode="double", length=0)
      for (i in  1:length(res$freq)) {
        if (res$freq[i]!=1 && length(max1)<3){
          max1[i]<-res$freq[i]
          periodo1[i]<-365/max1[i]
          
        }
      }
      abline(v=max1[1], lty="dotted",col="red")
      abline(v=max1[2], lty="dotted",col="blue")
      abline(v=max1[3], lty="dotted",col="black")
      
      datos_periodigrama_3g_trafico_2<-datos_periodigrama
      datos_periodigrama_3g_trafico_2<-ts(rev(dato$Trafico.2),start = c(lubridate::year(dato$Fecha)[1],yday(dato$Fecha)[1]),frequency = 365)
      res<-spec.pgram(datos_periodigrama_3g_trafico_2)
      order(res$spec,res$freq,decreasing = TRUE)
      max2<- vector(mode="numeric", length=0)
      periodo2<-vector(mode="double", length=0)
      for (i in  1:length(res$freq)) {
        if (res$freq[i]!=1 && length(max2)<3){
          max2[i]<-res$freq[i]
          periodo2[i]<-365/max2[i]
          
        }
      }
      abline(v=max2[1], lty="dotted",col="black")
      abline(v=max2[2], lty="dotted",col="orange")
      abline(v=max2[3], lty="dotted",col="purple")
      }
      
      
    }else{
      if(!is.na(individuos_acp[i])){
       dato<-sqldf(sprintf("select `Fecha`,`Id.Celda`,avg(`Trafico2.carga`) as `Trafico2.carga`,avg(`Trafico2.Descarga`) as `Trafico2.Descarga` 
                          from datos_4g where `Id.Celda`= '%s' group by `Fecha`", as.character(individuos_acp[i])))
      datos_periodigrama_4g_trafico2_carga<-datos_periodigrama
      datos_periodigrama_4g_trafico2_carga<-ts(rev(dato$Trafico2.carga),start = c(lubridate::year(dato$Fecha)[1],yday(dato$Fecha)[1]),frequency = 365)
      res<-spec.pgram(datos_periodigrama_4g_trafico2_carga)
      order(res$spec,res$freq,decreasing = TRUE)
      max1<- vector(mode="numeric", length=0)
      periodo1<-vector(mode="double", length=0)
      for (i in  1:length(res$freq)) {
        if (res$freq[i]!=1 && length(max1)<3){
          max1[i]<-res$freq[i]
          periodo1[i]<-365/max1[i]
          
        }
      }
      abline(v=max1[1], lty="dotted",col="red")
      abline(v=max1[2], lty="dotted",col="blue")
      abline(v=max1[3], lty="dotted",col="black")
      datos_periodigrama_4g_trafico2_descarga<-datos_periodigrama
      datos_periodigrama_4g_trafico2_descarga<-ts(rev(dato$Trafico2.Descarga),start = c(yday(dato$Fecha),lubridate::day(dato$Fecha)),frequency = 365)
      res<-spec.pgram(datos_periodigrama_4g_trafico2_descarga)
      order(res$spec,res$freq,decreasing = TRUE)
      max2<- vector(mode="numeric", length=0)
      periodo2<-vector(mode="double", length=0)
      for (i in  1:length(res$freq)) {
        if (res$freq[i]!=1 && length(max2)<3){
          max2[i]<-res$freq[i]
          periodo2[i]<-365/max2[i]
          
        }
      }
      abline(v=max2[1], lty="dotted",col="black")
      abline(v=max2[2], lty="dotted",col="orange")
      abline(v=max2[3], lty="dotted",col="purple") 
      }
    }
    
  }
  return(list(periodo1,periodo2))
}
ER <- function(Pron,Real) {
  return(sum(abs(Pron-Real))/sum(abs(Real)))
}
ECM<-function(Pred,Real) {
  N<-length(Real)
  ss<-sum((Real-Pred)^2)
  return((1/N)*ss)
}
RECM<-function(Pred,Real) {
  N<-length(Real)
  ss<-sum((Real-Pred)^2)
  return(sqrt((1/N)*ss))
}
PFA <- function(Pron,Real) {
  Total<-0
  N<-length(Pron)
  for(i in 1:N) {
    if(Pron[i]>Real[i])
      Total<-Total+1      
  }
  return(Total/N)
}
PTFA <- function(Pron,Real) {
  Total<-0
  SReal<-0
  N<-length(Pron)
  for(i in 1:N) {
    if(Pron[i]>Real[i]) {
      Total<-Total+(Pron[i]-Real[i])
      SReal<-SReal+abs(Real[i])
    }
  }
  if(Total==0)
    SReal=1
  return(Total/SReal)
}
centros.radar <- function (datos) {
  centros <- as.data.frame(apply(datos, 2, function(i)
    scales::rescale(i, to = c(0, 100))))
  
  res <- reshape::melt(t(centros), varnames = c("variables", "modelos"))
  res <- res[order(res$variables, decreasing = F), ]
  res$modelos <- as.character(res$modelos)
  ggplot(res, aes(x = variables, y = value)) + 
    geom_polygon(aes(group = modelos, color = modelos, fill = modelos), 
                 alpha = 0.3, size = 1, show.legend = FALSE) + 
    geom_point(aes(group = modelos, color = modelos), size = 3) + 
    theme(panel.background = element_rect(fill = "transparent"), 
          plot.background = element_rect(fill = "transparent"), 
          panel.grid.major = element_line(
            size = 0.5, linetype = "solid", colour = "#dddddd"), 
          axis.text.x = element_text(size = rel(1.2)), 
          axis.text.y = element_blank(), axis.ticks = element_blank()) + 
    scale_y_continuous(limits = c(-10, 100), breaks = c(0, 25, 50, 75, 100)) + 
    ggtitle("") + xlab("") + ylab("") + 
    geom_text(aes(x = 0.5, y = 0, label = "0%"), size = 3.5, colour = "#dddddd", family = "serif") + 
    geom_text(aes(x = 0.5, y = 25, label = "25%"), size = 3.5, colour = "#dddddd", 
              family = "serif") + 
    geom_text(aes(x = 0.5, y = 50, label = "50%"), size = 3.5, colour = "#dddddd", family = "serif") +
    geom_text(aes(x = 0.5, y = 75, label = "75%"), size = 3.5, colour = "#dddddd", family = "serif") + 
    geom_text(aes(x = 0.5, y = 100, label = "100%"), size = 3.5, colour = "#dddddd", family = "serif") +
    ggproto("CordRadar", CoordPolar, theta = "x", r = "y", start = 0, direction = sign(1))
}
calibrar.HW <- function(serie.aprendizaje,serie.testing) {
  error.c<-Inf
  alpha.i<-0.1  # alpha no puede ser cero
  while(alpha.i<=1) {
    beta.i<-0
    while(beta.i<=1) {
      gamma.i<-0
      while(gamma.i<=1) {
        mod.i<-HoltWinters(serie.aprendizaje,alpha=alpha.i,beta=beta.i,gamma=gamma.i)
        res.i<-predict(mod.i,n.ahead=length(serie.testing))
        error.i<-sqrt(ECM(res.i,serie.testing))
        if(error.i<error.c) {
          error.c<-error.i
          mod.c<-mod.i         
        }
        gamma.i<-gamma.i+0.1
      }
      beta.i<-beta.i+0.1
    }
    alpha.i<-alpha.i+0.1
  }  
  return(mod.c)
} 
calibrar.arima <- function(entrenamiento = NULL, prueba = NULL, periodo = NA_integer_, rango = 0:2) {
  # se calculan todas las combinaciones para los parametros
  params <- cross(list(a = rango, b = rango, c = rango,
                       d = 0:1, e = 0:1, f = 0:1))
  # se calcula un modelos para cada combinacion de parametros
  arima_secure <- possibly(stats::arima, otherwise = NULL)
  models <- map(params, ~ suppressWarnings(arima_secure(entrenamiento, order = c(.$a,.$b,.$c),
                                                        seasonal = list(order = c(.$d,.$e,.$f),
                                                                        period = periodo))))
  # se eliminan los modelos fallidos
  models <- keep(models, negate(is.null))
  # se hace una prediccion para cada modelos
  predictions <-map(models, ~predict(., n.ahead = length(prueba)))
  # se calcula el error para cada prediccion
  error <- map_dbl(predictions, function(pred, real) {
    error <- sum((as.numeric(real) - as.numeric(pred$pred))^2)
    return(error)
  }, real = prueba)
  
  # se retorna el modelo con el menor error
  best_model <- models[[which.min(error)]]
  p <- params[[which.min(error)]]
  best_model$call <- call("arima",
                          x = quote(datos), order = as.numeric(c(p$a, p$b, p$c)),
                          seasonal = list(order = as.numeric(c(p$d, p$e, p$f)),
                                          period = periodo))
  return(best_model)
}

Proyecto: Estudio de capacidad y demanda de una red celular.

Este proyecto abarca la temática del negocio de las telecomunicaciones en el ámbito de un operador celular con el fin de generar un estudio de minería de datos mediante el uso de la metodología CRIPS.

Fase 1

Fase 1

1.Determinar objetivos del negocio

Actualmente la industria de telecomunicaciones puede llegar a recolectar diariamente grandes cantidades de información acerca de temas como el comportamiento de la red, su rendimiento o calidad del servicio brindado. Esto involucra que el sector deba de poseer características como innovación, consolidación y fases de maduración en los equipos.

Un operador se basa en 3 ejes fundamentales:

  • Infraestructura de red.
  • Integración de servicios de acceso a la red.
  • Marketing y ventas.

Este estudio se basa bajo un enfoque técnico por lo que el objetivo del área de negocio consiste en analizar el funcionamiento y desempeño de la red móvil XXX, con el fin de identificar y realizar acciones que permitan mejorar las condiciones para la prestación de comunicaciones de voz y datos.

Como criterios de éxito se busca:

  • Preparar la red para futuras demandas.
  • Pronosticar el comportamiento de los equipos.

2.Valoración de la situación

Red celular

Red celular

Un proveedor de servicio celular debe manejar grandes cantidades de datos ya que estos deben de contemplar aspectos como datos personales de los clientes, registros de llamadas, registros de las interacciones que deba de realizar equipos varios (central,torre celular,etc) para procesar tanto llamadas de voz como el trasiego de datos provenientes de internet, o incluso información referente a ubicaciones de torres celulares.

El ambiente de trabajo se centrará en un análisis de registros de indicadores acerca de interacciones que deba de realizar la central y una torre celular para procesar tanto llamadas de voz como el trasiego de datos, esto abarcando las tecnologías 3G y 4G, con el fin de poder identificar:

  • Oportunidades de mejoras en equipos que registren elevados niveles de tráfico.
  • Generar recomendaciones como ampliaciones de equipos.

3.Determinar los objetivos de DM

Dicho análisis busca poder realizar el estudio de una red celular a través del uso de indicadores de rendimiento (kpi´s). Por lo que mediante el uso de minería de datos se busca poder analizar los siguientes aspectos.

  • Estudiar el tráfico cursado.
  • Identificar períodos de congestión en la red.
  • Verificar predicciones en tendencias de equipos con alto tráfico cursado.

4.Plan de proyecto

Se desea obtener como meta, un análisis entorno a los temas abordados en el cursos de series de tiempo, por lo que previamente se realizara un análisis exploratorio para poder identificar los equipos de mayor demanda en la red, y una vez identificados estos datos se empezará a generar un análisis en series de tiempo. Se desarrollarán los siguientes puntos:

  • Correlación de variables
  • Análisis de ACP
  • Test de normalidad de datos
  • Análisis de periodicidad
  • Definir calidades de pronósticos de tiempo(medición de error)
  • Generación de series de tiempo.
Fase 2

Fase 2

1.Recolección de los datos iniciales

Se trabajará con 2 documentos Excel en formato CSV , que contienen la información de la red 3G y 4G. Estos documentos se usarán de manera independiente ya que corresponden a términos,cálculos y tecnologías diferentes.

2.Descripción de los datos

3G

  • Fecha: Se indica un registro en el formato de YYYY/MM/DD
  • Controlador: Corresponde a un equipo servidor el cual se encuentra ligado cada una de las celdas.
  • Id celdas: Corresponde a las celdas celulares que se encuentran distribuidas en la red 3G.
  • Accesibilidad exitosa: Esta variable hace referencia a una serie de permisos que deben de establecerse entre los terminales y las celdas para poder ingresar a la red.
  • Accesibilidad de voz: Esta variable hace referencia a una serie de permisos que deben de realizarse para poder hacer llamadas de voz.
  • Accesibilidad de datos: Esta variable hace referencia a una serie de permisos he interacciones que deben de realizarse para poder hacer uso de los servicio de datos.
  • Tráfico 1 y 2: Variable correspondiente a cantidad de tráfico registrado,la variable 1 hace referencia llamadas telefónicas y la variable 2 ha servicios de datos , esta sería una variable a predecir por medio de una serie de tiempo.
  • Usuarios carga: Esta variable hace referencia a cuantos usuarios se encuentran utilizando servicio de datos para realizar carga de datos, ejemplo servicios de streaming.
  • Usuarios descarga: Esta variable hace referencia a cuantos usuarios se encuentran utilizando servicio de datos para realizar descarga de datos, ejemplo descargar alguna película.
  • Accesos XXX: Esta variable indica a que distancia se encuentran los usuarios de una celda utilizando los servicios móviles.
  • RTWP: Esta variable indica el nivel de interferencia que algún equipo externo a la red pueda estar perjudicando y no permita así poder realizar llamadas de voz o el uso de internet.

4G

  • Fecha: Se indica un registro en el formato de YYYY/MM/DD
  • Id_celdas: Corresponde a las celdas celulares que se encuentran distribuidas en la red 4G.
  • Accesibilidad exitosa: Esta variable hace referencia a una serie de permisos que deben de establecerse entre los terminales y las celdas para poder ingresar a la red.
  • Integridad: Hace referencia sobre el estado en el cual se encuentra el equipo.
  • Cantidad de usuarios: Esta variable hace referencia a cuantos usuarios se encuentran haciendo uso de servicio de datos.
  • Uso de recursos DL %: Esta variable indica el porcentaje de recursos que se están utilizando para realizar descargas de datos.
  • Uso de recursos UL %: Esta variable indica el porcentaje de recursos que se están utilizando para realizar cargas de datos.
  • paquetes perdidos %: Esta variable indica la cantidad de paquetes perdidos en una celda.
  • Accesos XXX: Esta variable indica a que distancia se encuentran los usuarios de una celda utilizando los servicios móviles.
  • Trafico2 Descarga: Variable correspondiente a cantidad de tráfico en descarga registrado, esta será una variable a predecir por medio de una serie de tiempo.
  • Trafico2 carga: Variable correspondiente a cantidad de tráfico en carga registrado, esta será una variable a predecir por medio de una serie de tiempo.

3.Exploración de los datos

options(warn=-1)
setwd("C://Users/JORGE-PC/Desktop/datos proyecto/DATOS DE MARZO A JUNIO")
datos_1<-read.csv("3g_mar_abr.csv", header = TRUE, dec = ".", sep = ",")
datos_2<-read.csv("3g_may_jun.csv", header = TRUE, dec = ".", sep = ",")
datos_3<-read.csv("3g_jul.csv", header = TRUE, dec = ".", sep = ",")
datos_4<-read.csv("3g_ago.csv", header = TRUE, dec = ".", sep = ",")
datos_5<-read.csv("4g_mar_abr.csv", header = TRUE, dec = ".", sep = ",")
datos_6<-read.csv("4g_may_jun.csv", header = TRUE, dec = ".", sep = ",")
datos_7<-read.csv("4g_jul.csv", header = TRUE, dec = ".", sep = ",")
datos_8<-read.csv("4g_ago.csv", header = TRUE, dec = ".", sep = ",")
datos_3g<-rbind(datos_1,datos_2,datos_3,datos_4)
datos_4g<-rbind(datos_5,datos_6,datos_7,datos_8)
remove(datos_1,datos_2,datos_3,datos_4,datos_5,datos_6,datos_7,datos_8)

"Se presentan 20 variables con xxx celdas en ambas tablas"
## [1] "Se presentan 20 variables con xxx celdas en ambas tablas"
dim(datos_3g)
## [1] 2307398      26
dim(datos_4g)
## [1] 1032914      24
head(datos_3g)
ABCDEFGHIJ0123456789
 
 
Date
<fctr>
RNC
<fctr>
Cell.Name
<fctr>
Cell.ID
<int>
Integrity
<fctr>
RRC.Setup.Success.Ratio..service........
<dbl>
11/3/2019LA_GUACIMAW1178C111783100%98.2428
21/3/2019LA_GUACIMAW1182A211825100%98.9708
31/3/2019LA_GUACIMAW1182C111823100%99.6080
41/3/2019LA_GUACIMAW1182A111821100%99.5527
51/3/2019LA_GUACIMAW1135B111352100%98.9825
61/3/2019LA_GUACIMAW1119B111192100%99.3131
head(datos_4g)
ABCDEFGHIJ0123456789
Accesos.de.702m.a.1.1Km
<int>
Cell.Throughput_DL..Mbps..Mbps.
<dbl>
Cell.Throughput_UL..Mbps..Mbps.
<dbl>
36210.96860.9789
60219.13061.9897
69414.94602.0310
74221.01412.7605
325321.45621.1090
242415.29261.4054
Fase 3

Fase 3

1.Selección de datos

Se eliminan las variables que no se requieren para los análisis.

datos_3g<-subset(datos_3g,select = -c(Cell.ID,Integrity,PS.RAB.Setup.Success.Rate...,CS.RAB.Setup.Success.Rate...,VS.CellDCHUEs,VS.CellFACHUEs.PTT,VS.MaxRTWP.dBm.))
datos_4g<-subset(datos_4g,select = -c(eNodeB.Name,Cell.FDD.TDD.Indication,LocalCell.Id,Integrity,Cell.DL.Average.Throughput.Mbps.,Cell.UL.Average.Throughput.Mbps.,L.Traffic.User.Avg,E.RAB.Setup.Success.Rate..ALL....,Volumen.Total.datos.LTE.DL..TB.,Volumen.Total.datos.LTE.UL..TB.))

2.Limpieza de datos

Se verifica el porcentaje de información nula que se podría encontrar en la variables,mediante el uso del paquete H2o se realiza el cambio de los valores nulos a el uso de la media de cada una de las columnas.

dato_nulo<-datos_3g %>% summarise_all(funs((sum(is.na(.))/n())*100))
dato_nulo<-gather(dato_nulo,key = "variable", value = "porcentaje de valores nulos")
ggplot(dato_nulo,aes(x=reorder(variable,`porcentaje de valores nulos`),y=`porcentaje de valores nulos`))+
  geom_bar(stat = "identity")+
  coord_flip()+theme_gray()+
  ylab("Porcentaje %")+xlab("Variables")+
  labs(title = "Variables nulas en 3G")

dato_nulo<-datos_4g %>% summarise_all(funs((sum(is.na(.))/n())*100))
dato_nulo<-gather(dato_nulo,key = "variable", value = "porcentaje de valores nulos")
ggplot(dato_nulo,aes(x=reorder(variable,`porcentaje de valores nulos`),y=`porcentaje de valores nulos`))+
  geom_bar(stat = "identity")+
  coord_flip()+theme_gray()+
  ylab("Porcentaje %")+xlab("Variables")+
  labs(title = "Variables nulas en 4G")

datos_3g<-valor_nulo(datos_3g)
##  Connection successful!
## 
## R is connected to the H2O cluster: 
##     H2O cluster uptime:         4 hours 9 seconds 
##     H2O cluster timezone:       America/Regina 
##     H2O data parsing timezone:  UTC 
##     H2O cluster version:        3.26.0.2 
##     H2O cluster version age:    1 month and 10 days  
##     H2O cluster name:           H2O_started_from_R_JORGE-PC_zve668 
##     H2O cluster total nodes:    1 
##     H2O cluster total memory:   5.43 GB 
##     H2O cluster total cores:    8 
##     H2O cluster allowed cores:  8 
##     H2O cluster healthy:        TRUE 
##     H2O Connection ip:          localhost 
##     H2O Connection port:        54321 
##     H2O Connection proxy:       NA 
##     H2O Internal Security:      FALSE 
##     H2O API Extensions:         Amazon S3, Algos, AutoML, Core V3, Core V4 
##     R Version:                  R version 3.5.3 (2019-03-11) 
## 
## Are you sure you want to shutdown the H2O instance running at http://localhost:54321/ (Y/N)?
datos_4g<-valor_nulo(datos_4g)
##  Connection successful!
## 
## R is connected to the H2O cluster: 
##     H2O cluster uptime:         4 hours 1 minutes 
##     H2O cluster timezone:       America/Regina 
##     H2O data parsing timezone:  UTC 
##     H2O cluster version:        3.26.0.2 
##     H2O cluster version age:    1 month and 10 days  
##     H2O cluster name:           H2O_started_from_R_JORGE-PC_zve668 
##     H2O cluster total nodes:    1 
##     H2O cluster total memory:   5.28 GB 
##     H2O cluster total cores:    8 
##     H2O cluster allowed cores:  8 
##     H2O cluster healthy:        TRUE 
##     H2O Connection ip:          localhost 
##     H2O Connection port:        54321 
##     H2O Connection proxy:       NA 
##     H2O Internal Security:      FALSE 
##     H2O API Extensions:         Amazon S3, Algos, AutoML, Core V3, Core V4 
##     R Version:                  R version 3.5.3 (2019-03-11) 
## 
## Are you sure you want to shutdown the H2O instance running at http://localhost:54321/ (Y/N)?
datos_4g<-datos_4g[-c(1),]

3.Estructuración de los datos

Las tablas se encuentran estructuradas con variables de tipo date, categóricas , numéricas y de tipo integer.

str(datos_3g)
## 'data.frame':    2307398 obs. of  19 variables:
##  $ Date                                    : Factor w/ 184 levels "01/07/2019","01/08/2019",..: 19 19 19 19 19 19 19 19 19 19 ...
##  $ RNC                                     : Factor w/ 7 levels "ALAJUELA_II_RNC",..: 5 5 5 5 5 5 5 5 5 5 ...
##  $ Cell.Name                               : Factor w/ 12778 levels "W01050010A1",..: 2741 2765 2768 2764 2399 2267 2147 2778 2776 2033 ...
##  $ RRC.Setup.Success.Ratio..service........: num  98.2 99 99.6 99.6 99 ...
##  $ RRC.Setup.Success.Ratio.CS...           : num  99.4 99.9 99.9 99.9 99.6 ...
##  $ RRC.Setup.Success.Ratio.PS              : num  97.8 97.5 99.5 98 98.4 ...
##  $ VS.AMR.Erlang.BestCell                  : num  108.8 37 198.7 156.4 91.9 ...
##  $ VS.HSUPA.UE.Max.Cell                    : int  31 17 44 19 37 31 15 53 30 33 ...
##  $ VS.HSDPA.UE.Max.Cell                    : int  27 17 32 18 28 29 14 45 28 27 ...
##  $ Accesos.a.mas.de.13.Km                  : int  5145 0 5 0 460 194 56 2109 4 854 ...
##  $ Accesos.a.menos.de.500.m                : int  400 2878 2991 6495 299 4552 1682 1034 3475 30067 ...
##  $ Accesos.entre.1.2.y.2.1.Km              : int  450 943 4136 1439 3939 5440 132 2177 6219 1370 ...
##  $ Accesos.entre.2.1.y.3.5.Km              : int  662 121 11816 137 2191 5331 2 486 1844 262 ...
##  $ Accesos.entre.3.5.a.5.9.Km              : int  1208 66 3661 23 5009 3249 2 6896 308 76 ...
##  $ Accesos.entre.5.9.y.8.1.Km              : int  6401 0 689 1 1522 317 79 8446 1157 8 ...
##  $ Accesos.entre.500.y.1200.m              : int  3001 1319 3829 2291 4621 1536 3590 1141 3931 7660 ...
##  $ Accesos.entre.8.1.y.13.Km               : int  2502 0 15 0 1677 21 211 8130 67 567 ...
##  $ VS.MeanRTWP.dBm.                        : num  -101 -105 -103 -106 -104 ...
##  $ VS.HSDPA.Kbps.MeanChThroughput          : num  1077 774 1483 937 1542 ...
str(datos_4g)
## 'data.frame':    1032914 obs. of  14 variables:
##  $ Date                                  : Factor w/ 185 levels "01/03/2019","01/04/2019",..: 1 1 1 1 1 1 1 1 1 1 ...
##  $ Cell.Name                             : Factor w/ 5817 levels "3054A1","3054B1",..: 5012 5035 5025 4582 4581 3535 3323 3603 3581 5091 ...
##  $ RRC.Setup.Success.Rate...             : num  99.9 99.7 100 100 100 ...
##  $ L.Traffic.User.Max                    : num  19 18 43 10 19 39 83 85 43 101 ...
##  $ DL.PRB.Usage.Rate...                  : num  3.19 2.13 7.82 1.58 2.26 ...
##  $ UL.PRB.Usage.Rate...                  : num  6.97 5.88 7.79 3.43 4.91 ...
##  $ DL.Packet.Loss.Rate.of.Data.Service...: num  3e-04 1e-04 1e-04 5e-04 2e-04 2e-04 1e-04 2e-04 1e-04 1e-04 ...
##  $ Accesos.2.1Km.a.3.5Km                 : num  5826 3174 426 3456 10887 ...
##  $ Accesos.a.mï...de.3.5Km               : num  160 1063 676 64 141 ...
##  $ Accesos.de.0m.a.624m                  : num  17733 16010 96343 7560 7140 ...
##  $ Accesos.de.1.1Km.a.2.1Km              : num  16875 1449 1262 640 12083 ...
##  $ Accesos.de.702m.a.1.1Km               : num  362 602 694 742 3253 ...
##  $ Cell.Throughput_DL..Mbps..Mbps.       : num  11 19.1 14.9 21 21.5 ...
##  $ Cell.Throughput_UL..Mbps..Mbps.       : num  0.979 1.99 2.031 2.76 1.109 ...

4.Integración de los datos

Se cambia el formato de la variable Fecha en las tablas 3G y 4G

datos_3g$Date<-dmy(datos_3g$Date)
datos_4g$Date<-dmy(datos_4g$Date)
as.data.frame(summary(datos_3g))
ABCDEFGHIJ0123456789
Var1
<fctr>
Var2
<fctr>
Freq
<fctr>
DateMin. :2019-03-01
Date1st Qu.:2019-04-16
DateMedian :2019-06-01
DateMean :2019-05-31
Date3rd Qu.:2019-07-17
DateMax. :2019-08-31
DateNA
RNCALAJUELA_II_RNC :329835
RNCALAJUELA_RNC :166667
RNCHEREDIA_RNC :255018
as.data.frame(summary(datos_4g))
ABCDEFGHIJ0123456789
Var1
<fctr>
Var2
<fctr>
Freq
<fctr>
DateMin. :2019-03-01
Date1st Qu.:2019-04-17
DateMedian :2019-06-02
DateMean :2019-06-01
Date3rd Qu.:2019-07-18
DateMax. :2019-08-31
DateNA
Cell.NameL03102303A1: 303
Cell.NameL03154182A1: 204
Cell.NameL07202784A1: 185

5.Formateo de los datos

Se realiza una re-estructuración de los datos para una mejor comprenhensión

names(datos_3g)[1]<-"Fecha"
names(datos_3g)[2]<-"Controlador"
names(datos_3g)[3]<-"Id.Celda"
names(datos_3g)[4]<-"Accesibilidad.exitosa"
names(datos_3g)[5]<-"Accesibilidad.en.voz"
names(datos_3g)[6]<-"Accesibilidad.en.datos"
names(datos_3g)[7]<-"Trafico.1"
names(datos_3g)[8]<-"Usuarios.Carga"
names(datos_3g)[9]<-"Usuarios.descarga"
names(datos_3g)[18]<-"Promedio.RTWP"
names(datos_3g)[19]<-"Trafico.2"


names(datos_4g)[1]<-"Fecha"
names(datos_4g)[2]<-"Id.Celda"
names(datos_4g)[3]<-"Accesibilidad.exitosa"
names(datos_4g)[4]<-"Cantidad.de.usuarios"
names(datos_4g)[5]<-"Uso.de.recursos.DL"
names(datos_4g)[6]<-"Uso.de.recursos.UL"
names(datos_4g)[7]<-"Paquetes.perdidos"
names(datos_4g)[13]<-"Trafico2.Descarga"
names(datos_4g)[14]<-"Trafico2.carga"
names(datos_4g)[9]<-"Accesos.a.mas.de.3.5Km"

datos_3g<-sqldf("select `Fecha`,`Controlador`,`Id.Celda`,`Accesibilidad.exitosa`,`Accesibilidad.en.voz`,`Accesibilidad.en.datos`,`Usuarios.Carga`,`Usuarios.descarga`,`Promedio.RTWP`,`Accesos.a.menos.de.500.m`,`Accesos.entre.500.y.1200.m`,`Accesos.entre.1.2.y.2.1.Km`,`Accesos.entre.2.1.y.3.5.Km`,`Accesos.entre.3.5.a.5.9.Km`,`Accesos.entre.5.9.y.8.1.Km`,`Accesos.entre.8.1.y.13.Km`,`Accesos.a.mas.de.13.Km`,`Trafico.1`,`Trafico.2` from datos_3g")
datos_4g<-sqldf("select `Fecha`,`Id.Celda`,`Accesibilidad.exitosa`,`Cantidad.de.usuarios`,`Uso.de.recursos.DL`,`Uso.de.recursos.UL`,`paquetes.perdidos`,`Accesos.de.0m.a.624m`,`Accesos.de.702m.a.1.1Km`,`Accesos.de.1.1Km.a.2.1Km`,`Accesos.2.1Km.a.3.5Km`,`Accesos.a.mas.de.3.5Km`,`Trafico2.Descarga`,`Trafico2.carga` from datos_4g")
Fase 4

Fase 4

1.Selección de la técnica de modelado

Se utiliza estadística básica para observar comportamientos en la variables con respecto a los individuos y luego se realizará el análisis exploratorio para obtener los individuos a los cuales se les hará el estudio de serie de tiempo.

2.Generar de plan de prueba

Se desarrollará un plan con los siguientes aspectos a evaluar

  • 1.Determinar días de mayor consumo de tráfico.
  • 2.Determinar la distribución normal de las variables accesibilidad,usuarios,tráfico y recursos.
  • 3.Determinar cúal es la correlación que tienen las variables.
  • 4.Observar las atipicidades de los datos.
  • 5.Generar gráficos de dispersición entre variables con correlaciones más fuertes
  • 6.Generar un top 5 de individuos con base al anáisis de las variables realizado.
  • 7.Generar un análisis de componentes principales para determinar la ‘fuerza’ de correlación que se da entre variables y los individuos seleccionados.
  • 8.Generar un test de normalidad para determinar si las variables a predecir de los individuos seleccionados siguen la distribución normal.
  • 9.Observar las atipicidades de los individuos selecionados.
  • 10.Generar un suavizado para la información con el fin de verificar si se eliminan datos atípicos.
  • 11.Generar peridiogramas para observar atravez de la frecuencia del tiempo cada cuanto se producen eventos de importancia en los individuos.
  • 12.Desarrollar mediciones de error utilizando los algoritmos de Box-Jenkings y Holt-Winters para determinar que método se va a utilizar en las predicciones de los individuos.
  • 13.Desarrollar las predicciones de series de tiempo.

3.Construcción del modelo

Determinar días de mayor consumo de tráfico.

promedio_trafico_3g<-sqldf("select avg(`Trafico.1`) as `Promedio.Traf.1`,avg(`Trafico.2`) as `Promedio.Traf.2`,case cast (strftime('%w',Fecha) as integer)
                           when 0 then 'Domingo'
                           when 1 then 'Lunes'
                           when 2 then 'Martes'
                           when 3 then 'Miércoles'
                           when 4 then 'Jueves'
                           when 5 then 'Viernes'
                           else 'Sábado' end as Dia
                           from datos_3g 
                           group by strftime('%w', Fecha)
                           order by  avg(`Trafico.1`) desc ,avg(`Trafico.2`) desc")
promedio_trafico_4g<-sqldf("select avg(`Trafico2.Descarga`) as `Promedio.Descarga`,avg(`Trafico2.carga`) as `Promedio.Carga`,case cast (strftime('%w',Fecha) as integer)
                           when 0 then 'Domingo'
                           when 1 then 'Lunes'
                           when 2 then 'Martes'
                           when 3 then 'Miércoles'
                           when 4 then 'Jueves'
                           when 5 then 'Viernes'
                           else 'Sábado' end as Dia
                           from datos_4g 
                           group by strftime('%w', Fecha)
                           order by  avg(`Trafico2.Descarga`) desc ,avg(`Trafico2.carga`) desc")

ggplot(promedio_trafico_3g,aes(x=fct_reorder(Dia,Promedio.Traf.1),y=Promedio.Traf.1,fill=Dia))+
  geom_bar(stat="identity")+
  coord_flip()+
  labs(x="",y="Promedio de tráfico",title = "Promedio de mayor volúmen de tráfico (Horas/voz) por día en la red 3G") +
  theme(plot.title = element_text(hjust = .5),
        plot.caption = element_text(hjust = 0))

ggplot(promedio_trafico_3g,aes(x=fct_reorder(Dia,Promedio.Traf.2),y=Promedio.Traf.2,fill=Dia))+
  geom_bar(stat="identity")+
  coord_flip()+
  labs(x="",y="Promedio de tráfico",title = "Promedio de mayor volúmen de tráfico (carga/descarga) por día en la red 3G") +
  theme(plot.title = element_text(hjust = .5),
        plot.caption = element_text(hjust = 0))

ggplot(promedio_trafico_4g,aes(x=fct_reorder(Dia,Promedio.Descarga),y=Promedio.Descarga,fill=Dia))+
  geom_bar(stat="identity")+
  coord_flip()+
  labs(x="",y="Promedio de tráfico",title = "Promedio de mayor volúmen de tráfico (descarga) por día en la red 4G") +
  theme(plot.title = element_text(hjust = .5),
        plot.caption = element_text(hjust = 0))

resultado<-sqldf("select Dia from promedio_trafico_3g order by `Promedio.Traf.1` desc limit 1")
resultado2<-sqldf("select Dia from promedio_trafico_3g order by `Promedio.Traf.2` desc limit 1")
resultado3<-sqldf("select Dia from promedio_trafico_4g order by `Promedio.Descarga` desc limit 1")
paste("Se verifica cual es el día en que se registra un mayor volumen de tráfico y se determina que para la red 3G el día",resultado,"registra un promedio mayor con respecto al tráfico 1 correspondiente a temas de horas/voz, mientras que el tráfico 2 (consumo de datos)  representa el día",resultado2,"y para la red 4G el día",resultado3,"registra un promedio mayor de consumo de datos.",sep = " ")
## [1] "Se verifica cual es el día en que se registra un mayor volumen de tráfico y se determina que para la red 3G el día Viernes registra un promedio mayor con respecto al tráfico 1 correspondiente a temas de horas/voz, mientras que el tráfico 2 (consumo de datos)  representa el día Martes y para la red 4G el día Jueves registra un promedio mayor de consumo de datos."
remove(promedio_trafico_3g,promedio_trafico_4g)

Determinar la distribución normal de las variables accesibilidad,usuarios,tráfico y recursos

3G

paste("Se analizaran los datos del primer mes con respecto a los días",resultado2,resultado3,resultado,sep = " ")
## [1] "Se analizaran los datos del primer mes con respecto a los días Martes Jueves Viernes"
datos_3g_estadistico<- datos_3g %>% 
  filter(weekdays(Fecha)=='Tuesday'|weekdays(Fecha)=='Thursday'|weekdays(Fecha)=='Friday') %>% 
  filter(lubridate::month(Fecha)=='3') %>% 
  select_all() 
Se grafica la distribución normal del periodo recolectado en la variable Accesibilidad exitosa, se observa que el mayor volúmen de individuos poseen una media superior al 95% ,sin embargo el estudio busca poder ubicar los individuos que registren valores inferiores al 90% ya que este indicador puede hacer enfásis mayor consumo de recursos
ggplot(datos_3g_estadistico,aes((datos_3g_estadistico$Accesibilidad.exitosa)))+
  geom_histogram(aes(y =(..count..)), 
                 col="black", 
                 fill="green", 
                 alpha = .2)+
  theme_classic()+
  scale_x_continuous(breaks = c(0,10,20,30,40,50,60,70,80,90,95,100),
                     labels = c("0","10","20","30","40","50","60","70","80","90","95","100"))+
  scale_y_continuous(breaks = c(0,25000,50000,100000,130000,160000),
                     labels = scales::comma)+
  labs(x="%",y="Cantidad de celdas reportadas")+
  labs(title = "Gráfico de normalidad de tabla 3G en variable Accesibilidad exitosa")
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

Se grafica la distribución normal del periodo recolectado en la variable usuarios.descarga, se observa que existen alrededor de 34,000 registros cuya media es de 10 unidades equivalentes a cantidades de usuarios registrados,sin embargo el estudio busca poder ubicar los individuos que registren valores superiores a >20 usuarios ya que estos representan un mayor consumo en la variable
ggplot(datos_3g_estadistico,aes((datos_3g_estadistico$Usuarios.descarga)))+
  geom_histogram(aes(y =(..count..)), 
                 col="black", 
                 fill="green", 
                 alpha = .2)+
  theme_classic()+
  scale_x_continuous(breaks = c(0,10,20,30,40,50,60,70,80,90,95,100),
                     labels = c("0","10","20","30","40","50","60","70","80","90","95","100"))+
  scale_y_continuous(breaks = c(0,5000,10000,15000,20000,25000,30000,34000),
                     labels = scales::comma)+
  labs(x="Cantidad de usuarios",y="Cantidad de celdas reportadas")+
  labs(title = "Gráfico de normalidad de tabla 3G en variable Usuarios en descarga")
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

Se grafica la distribución normal del periodo recolectado en la variable usuarios.carga, se observa que existen alrededor de 25,000 registros cuya media es de 10 a 20 unidades equivalentes a cantidades de usuarios registrados,sin embargo el estudio busca poder ubicar los individuos que registren valores superiores a >20 usuarios ya que estos representan individuos con mayor cantidad de usuarios.
ggplot(datos_3g_estadistico,aes((datos_3g_estadistico$Usuarios.Carga)))+
  geom_histogram(aes(y =(..count..)), 
                 col="black", 
                 fill="green", 
                 alpha = .2)+
  theme_classic()+
  scale_x_continuous(breaks = c(0,10,15,20,30,40,50,60,70,80,90,95,100),
                     labels = c("0","10","15","20","30","40","50","60","70","80","90","95","100"))+
  scale_y_continuous(breaks = c(0,5000,10000,15000,20000,25000,30000,34000),
                     labels = scales::comma)+
  labs(x="Cantidad de usuarios",y="Cantidad de celdas reportadas")+
  labs(title = "Gráfico de normalidad de tabla 3G en variable Usuarios en carga")
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

Por motivos de temas de confidencialidad se le aplica base logaritmica a la variable tráfico 1, la mayoria de los individuos se ubican en la media de 4 unidades equivalentes horas/voz, sin embargo el estudio busca poder ubicar individuos que estén fuera de la desviación estandar > 5.
Por otra parte a la hora de aplicar la distribución normal sin log ,se observa que existen alrededor de 55,000 registros cuya media es de 30 unidades equivalentes a horas/voz,sin embargo el estudio busca poder ubicar los individuos que registren valores superiores a >100 (Horas/Voz) ya que estos representan un mayor consumo en la variable.
ggplot(datos_3g_estadistico,aes((log(datos_3g_estadistico$Trafico.1))))+
  geom_histogram(aes(y =(..count..)),
                 col="black",
                 fill="green",
                 alpha = .2)+
  theme_classic()+
   scale_x_continuous(breaks = c(0,1,2,3,4,5,6,7,8,9,10),
                      labels = c("0","1","2","3","4","5","6","7","8","9","10"))+
   scale_y_continuous(breaks = c(0,10000,20000,24000),
                      labels = scales::comma)+
  labs(x="Cantidad de tráfico 1",y="Cantidad de celdas reportadas")+
  labs(title = "Gráfico de normalidad de tabla 3G en variable Tráfico 1")
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

Por motivos de temas de confidencilidad no se puede revelar la distribucion normal de la variable tráfico 2, se observa que existen alrededor de 32,000 registros cuya media es de 150 Kbps,sin embargo el estudio busca poder ubicar los individuos que registren valores superiores a >1000Kbps ya que estos representan un mayor consumo
# ggplot(datos_3g_estadistico,aes(((datos_3g_estadistico$Trafico.1))))+
#   geom_histogram(aes(y =(..count..)),
#                  col="black",
#                  fill="green",
#                  alpha = .2)+
#   theme_classic()+
#   labs(x="Cantidad de tráfico 1",y="Cantidad de celdas reportadas")+
#   labs(title = "Gráfico de normalidad de tabla 3G en variable Tráfico 1")

4G

datos_4g_estadistico<-datos_4g %>% 
  filter(weekdays(Fecha)=='Tuesday'|weekdays(Fecha)=='Thursday'|weekdays(Fecha)=='Friday') %>% 
  filter(lubridate::month(Fecha)=='3') %>% 
  select_all() 
Se grafica la distribución normal de la variable Accesibilidad.existosa, se observa que el mayor volúmen de individuos poseeen una media superior al 100,sin embargo el estudio busca poder ubicar los individuos que registren valores inferiores al 95% ya que estos representan un mayor uso de recursos.
ggplot(datos_4g_estadistico,aes((datos_4g_estadistico$Accesibilidad.exitosa)))+
  geom_histogram(aes(y =(..count..)), 
                 col="black", 
                 fill="green", 
                 alpha = .2)+
  theme_classic()+
  scale_x_continuous(breaks = c(90,95,100),
                     labels = c("90","95","100"))+
  scale_y_continuous(labels = scales::comma)+
  labs(x="Accesibilidad exitosa %",y="Cantidad de individuos")+
  labs(title = "Gráfico de normalidad de tabla 4G en variable Accesibilidad existosa")
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

Se grafica la distribución normal de la variable cantidad de usuarios, se observa que existen alrededor de 30,000 registros cuya media es de 50 usuarios, sin embargo el estudio busca poder ubicar los individuos en donde la cantidad de usuarios reportados sea > 100 ya que estos representan individuos con bastante cantidad de usuarios
ggplot(datos_4g_estadistico,aes((datos_4g_estadistico$Cantidad.de.usuarios)))+
  geom_histogram(aes(y =(..count..)), 
                 col="black", 
                 fill="green", 
                 alpha = .2)+
  theme_classic()+
  scale_x_continuous(breaks = c(0,50,100,200,300,400,500),
                     labels = c("0","50","100","200","300","400","500"))+
  scale_y_continuous(labels = scales::comma)+
  labs(x="Cantidad de usuarios",y="Cantidad de celdas reportadas")+
  labs(title = "Gráfico de normalidad de tabla 4G en variable cantidad de usuarios")
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

Se grafica la distribución normal de la variable uso de recursos.DL, se observa que existen alrededor de 14,000 registros cuya es de media de 5% uso de los recursos, sin embargo el estudio busca poder ubicar los individuos en donde el uso de recursos sea superior al > 15% ya que estos representan un mayor consumo.
ggplot(datos_4g_estadistico,aes((datos_4g_estadistico$Uso.de.recursos.DL)))+
  geom_histogram(aes(y =(..count..)), 
                 col="black", 
                 fill="green", 
                 alpha = .2)+
  theme_classic()+
  scale_x_continuous(breaks = c(0,5,10,15,20,30,40,50,60,70,80,90,100),
                     labels = c("0","5","10","15","20","30","40","50","60","70","80","90","100"))+
  scale_y_continuous(breaks = c(0,5000,10000,14000),
                     labels = scales::comma)+
  labs(x="uso de recursos DL %",y="Cantidad de celdas reportadas")+
  labs(title = "Gráfico de normalidad de tabla 4G en variable Uso de recursos.DL")
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

Por motivos de temas de confidencilidad no se puede revelar la distribucion normal de la variable trafico2.Descarga, sin embargo se indica que se observa que existen alrededor de 18,000 registros cuya media es de 15Mbps, por lo que se buscarán individuos que asemejen este comportamiento.

Determinar cúal es la correlación que tienen las variables.

Se puede observar que se da una fuerta correlación entre variables usuarios carga-descarga,además tráfico 2 se encuentra relacionada fuertemente con variables de usuarios de carga y descarga. También se obtiene una fuerte correlación entre la variable de tráfico 1 y accesos a menos de 500mtrs , por lo que hace referencia a que los servicios mayormente son utilizados a esta distancia.Por último se observa que existe una fuerte correlación entre las variables de ‘accesibilidad’.
correlacion_datos_3g_estadistico<-as.matrix(datos_3g_estadistico[,4:19])
correlacion_datos_3g_estadistico<-cor(correlacion_datos_3g_estadistico)
corrplot(correlacion_datos_3g_estadistico,mar=c(0,0,1,0),number.digits = 1,method = "number",type = "upper",order = "FPC",title = "Correlación de variables en 3G")

Se puede observar que se da una fuerte correlación entre variables de uso.de.recursos.DL y cantidad de usuarios, también esta correlación se dará entre la variable de uso.de.recursos.UL. Existe tambien un fuerte correlación entre la variable de cantidad de usuarios y los accesos a menos de 624m.Por otra parte las variables a predecir no presenta una correlación fuerte entre sí , por lo que no influyen los valores que se obtengan entre estas variables.
correlacion_datos_4g_estadistico<-as.matrix(subset(datos_4g_estadistico,select=-c(Fecha,Id.Celda)))
correlacion_datos_4g_estadistico<-cor(correlacion_datos_4g_estadistico)
corrplot(correlacion_datos_4g_estadistico,mar=c(0,0,1,0),number.digits = 1, method = "number",type = "upper",order = "FPC",title = "Correlación de variables en 4G")

Observar las atipicidades de los datos.

Nota:Se utiliza el 10% de la información, no se utiliza validación cruzada para obtener este dato, por motivo de uso de series de tiempo

Se busca valores atipicos en las variables de la tabla 3G que cumplan con características como:

  • Accesibilidad exitosa < 96%
  • Trafico 1 > 100 (Horas/Voz)
  • Trafico 2 > 1000 Kbps
  • Usuarios descarga >20
  • Usuarios carga >20
num.data <- round(nrow(datos_3g_estadistico)*0.1)
datos_3g_estadistico_atipicidad<-datos_3g_estadistico[1:num.data,]

boxplot(datos_3g_estadistico_atipicidad[,c(4,5,6)],ylab="%",las = 1,col=c("red","sienna","palevioletred1"),outpch=19,ylim=c(80,101),main="Valores atípicos para las variables de accesibilidad")

boxplot(datos_3g_estadistico_atipicidad[,c(18)],ylab="Horas/Voz",las=1,col="green",ylim=c(0,300),outpch=19,main="Valores atípicos para la variable tráfico 1 'hora/voz'")

boxplot(datos_3g_estadistico_atipicidad[,c(19)],ylab = "Kbps",las=1,col="green",ylim=c(0,4000),outpch=19,main="Valores atípicos para la variable tráfico 2")

boxplot(datos_3g_estadistico_atipicidad[,c(7,8)],ylab="Cantidad",col=c("red","sienna"),ylim=c(0,100),outpch=19,main="Valores atípicos para las variables de usuario carga / descarga")

Se busca valores atipicos en las variables de la tabla 4G que cumplan con características como:

  • Accesibilidad exitosa < 98%
  • Cantidad de usuarios > 100
  • Uso de recursos DL y UL > 15%
  • Trafico2.descarga > 15Mbps
  • Trafico2.carga > 3Mbps
num.data <- round(nrow(datos_4g_estadistico)*0.1)
datos_4g_estadistico_atipicidad<-datos_4g_estadistico[1:num.data,]

boxplot(datos_4g_estadistico_atipicidad[,c(3)],col="green",outpch=19,ylim=c(96,100),ylab = "%",main="Valores atípicos para accesibilidad exitosa")

boxplot((datos_4g_estadistico_atipicidad[,c(4)]),col="green",outpch=19,ylim=c(0,500),ylab = "Cantidad",main="Valores atípicos para cantidad de usuarios")

boxplot(datos_4g_estadistico_atipicidad[,c(5,6)],col=c("red","sienna"),outpch=19,ylim=c(0,60),ylab = "%",main="Valores atípicos para uso de recursos")

boxplot(datos_4g_estadistico_atipicidad[,c(13,14)],col=c("red","sienna"),outpch=19,ylim=c(1,40),ylab = "Kbps",main="Valores atípicos para tráfico 2")

Generar gráficos de dispersión entre variables con correlaciones más fuertes

Nota:Se utiliza el 10% de la información

num.data <- round(nrow(datos_3g_estadistico)*0.1)
datos_3g_estadistico_dispersion<-datos_3g_estadistico[1:num.data,]
Se determina que entre ambas variables, la correlación tiende ser fuerte de manera positiva.
ggplot(datos_3g_estadistico_dispersion,aes(x=datos_3g_estadistico_dispersion$Usuarios.Carga,y=datos_3g_estadistico_dispersion$Usuarios.descarga))+coord_flip()+
  labs(x="Usuarios en carga",y="Usuarios en descarga")+labs(title = "Gráfico de dispersión 3G")+theme_classic()+geom_point(col="black")

Se determina que entre ambas variables, la correlación tiende ser débil de manera positiva.
ggplot(datos_3g_estadistico_dispersion,aes(x=datos_3g_estadistico_dispersion$Trafico.2,y=datos_3g_estadistico_dispersion$Usuarios.descarga))+geom_point()+coord_flip()+
  labs(x="Tráfico 2 (Kbps)",y="usuarios descarga")+labs(title = "Gráfico de dispersión 3G")+theme_classic()+geom_point(col="black")

Se determina que entre ambas variables, la correlación tiende ser débil de manera nula
ggplot(datos_3g_estadistico_dispersion,aes(x=datos_3g_estadistico_dispersion$Trafico.1,y=datos_3g_estadistico_dispersion$Accesos.a.menos.de.500.m))+geom_point()+coord_flip()+
  labs(x="Tráfico 1",y=" Acces.menos.500m")+labs(title = "Gráfico de dispersión 3G")+theme_classic()+geom_point(col="black")

Se determina que entre ambas variables, la correlación tiende ser fuerte de manera positiva
ggplot(datos_3g_estadistico_dispersion,aes(x=datos_3g_estadistico_dispersion$Accesibilidad.exitosa,y=datos_3g_estadistico_dispersion$Accesibilidad.en.datos))+geom_point()+coord_flip()+
  labs(x="Acces.exitosa",y="Acces.datos")+labs(title = "Gráfico de dispersión 3G")+theme_classic()+geom_point(col="black")

plot_ly(x=datos_3g_estadistico_dispersion$Accesibilidad.exitosa, y=datos_3g_estadistico_dispersion$Accesibilidad.en.voz, z=datos_3g_estadistico_dispersion$Accesibilidad.en.datos,
        type="scatter3d") %>% 
  layout(
    title = "Gráfico de dispersión de las variables de accesiblidad",
    scene = list(
      xaxis = list(title = "Acces.existosa.X"),
      yaxis = list(title = "Acces.voz.Y"),
      zaxis = list(title = "Acces.datos.Z")
    )) 
## No scatter3d mode specifed:
##   Setting the mode to markers
##   Read more about this attribute -> https://plot.ly/r/reference/#scatter-mode
Gráfico de dispersión de las variables de accesiblidad
num.data <- round(nrow(datos_4g_estadistico)*0.1)
datos_4g_estadistico_dispersion<-datos_4g_estadistico[1:num.data,]
Se determina que entre ambas variables, la correlación tiende ser débil de manera positiva.
ggplot(datos_4g_estadistico_dispersion,aes(x=datos_4g_estadistico_dispersion$Uso.de.recursos.DL,y=datos_4g_estadistico_dispersion$Cantidad.de.usuarios))+geom_point()+coord_flip()+
  labs(x="Uso de recursos DL",y="Cantidad de usuarios")+labs(title = "Gráfico de dispersión 4G")+theme_classic()+geom_point(col="black")

Se determina que entre ambas variables, la correlación tiende ser fuerte de manera positiva.
ggplot(datos_4g_estadistico_dispersion,aes(x=datos_4g_estadistico_dispersion$Cantidad.de.usuarios,y=datos_4g_estadistico_dispersion$Accesos.de.0m.a.624m))+geom_point()+coord_flip()+
  labs(x="Cantidad de usuarios",y="Acces.0m.624m")+labs(title = "Gráfico de dispersión 4G")+theme_classic()+geom_point(col="black")

Se determina que entre ambas variables, la correlación tiende ser nula.
ggplot(datos_4g_estadistico_dispersion,aes(x=datos_4g_estadistico_dispersion$Trafico2.carga,y=datos_4g_estadistico_dispersion$Trafico2.Descarga))+geom_point()+coord_flip()+
  labs(x="Tráfico.carga (Mbps)",y="Tráfico.descarga (Mbps)")+labs(title = "Gráfico de dispersión 4G")+theme_classic()+geom_point(col="black")

Se eliminan variables que ya no se van a utilizar

remove(datos_3g_estadistico,datos_3g_estadistico_atipicidad,datos_3g_estadistico_dispersion,datos_4g_estadistico,datos_4g_estadistico_atipicidad,datos_4g_estadistico_dispersion)

Generar un top 5 de individuos con base al análisis de las variables realizado.

3G

datos_3g_ACP<-subset(datos_3g,select = -c(Fecha,Controlador))
datos_3g_ACP<-datos_3g_ACP %>% 
  group_by(Id.Celda) %>% 
  select(Id.Celda,Accesibilidad.exitosa,Accesibilidad.en.voz,
         Accesibilidad.en.datos,Usuarios.Carga,Usuarios.descarga,
         Promedio.RTWP,Accesos.a.menos.de.500.m,Accesos.entre.500.y.1200.m,
         Accesos.entre.1.2.y.2.1.Km,Accesos.entre.2.1.y.3.5.Km,Accesos.entre.3.5.a.5.9.Km,
         Accesos.entre.5.9.y.8.1.Km,Accesos.entre.8.1.y.13.Km,Accesos.a.mas.de.13.Km,Trafico.1,Trafico.2) %>% 
  mutate(Accesibilidad.exitosa=mean(Accesibilidad.exitosa)) %>% 
  mutate(Accesibilidad.en.voz=mean(Accesibilidad.en.voz)) %>% 
  mutate(Accesibilidad.en.datos=mean(Accesibilidad.en.datos)) %>% 
  mutate(Usuarios.Carga=mean(Usuarios.Carga)) %>% 
  mutate(Usuarios.descarga=mean(Usuarios.descarga)) %>% 
  mutate(Promedio.RTWP=mean(Promedio.RTWP)) %>% 
  mutate(Accesos.a.menos.de.500.m=mean(Accesos.a.menos.de.500.m)) %>% 
  mutate(Accesos.entre.500.y.1200.m=mean(Accesos.entre.500.y.1200.m)) %>% 
  mutate(Accesos.entre.1.2.y.2.1.Km=mean(Accesos.entre.1.2.y.2.1.Km)) %>% 
  mutate(Accesos.entre.2.1.y.3.5.Km=mean(Accesos.entre.2.1.y.3.5.Km)) %>% 
  mutate(Accesos.entre.3.5.a.5.9.Km=mean(Accesos.entre.3.5.a.5.9.Km)) %>% 
  mutate(Accesos.entre.5.9.y.8.1.Km=mean(Accesos.entre.5.9.y.8.1.Km)) %>% 
  mutate(Accesos.entre.8.1.y.13.Km=mean(Accesos.entre.8.1.y.13.Km)) %>% 
  mutate(Accesos.a.mas.de.13.Km=mean(Accesos.a.mas.de.13.Km)) %>% 
  mutate(Trafico.1=mean(Trafico.1)) %>% 
  mutate(Trafico.2=mean(Trafico.2))
datos_3g_ACP<-unique(as.data.frame(datos_3g_ACP))

datos_3g_ACP<-sqldf("select * from datos_3g_ACP 
                    where `Accesibilidad.exitosa` <>0 
                    and `Accesibilidad.exitosa` < 97
                    and `Trafico.1`> 100
                    and `Trafico.2`> 1000
                    and `Usuarios.Carga`> 20
                    and `Usuarios.descarga`> 20
                    group by `Id.celda` order by `Accesibilidad.exitosa` desc limit 5")

rownames(datos_3g_ACP)<-datos_3g_ACP$Id.Celda
datos_3g_ACP<-subset(datos_3g_ACP,select = -c(Id.Celda))

4G

datos_4g_ACP<-subset(datos_4g,select = -c(Fecha))
datos_4g_ACP<-datos_4g_ACP %>% 
  group_by(Id.Celda) %>% 
  select(Id.Celda,Accesibilidad.exitosa,Cantidad.de.usuarios,Uso.de.recursos.DL,Uso.de.recursos.UL,Paquetes.perdidos,Accesos.de.0m.a.624m,
         Accesos.de.702m.a.1.1Km,Accesos.de.1.1Km.a.2.1Km,Accesos.2.1Km.a.3.5Km,Accesos.a.mas.de.3.5Km,Trafico2.Descarga,Trafico2.carga) %>% 
  mutate(Accesibilidad.exitosa=mean(Accesibilidad.exitosa)) %>% 
  mutate(Cantidad.de.usuarios=mean(Cantidad.de.usuarios)) %>% 
  mutate(Uso.de.recursos.DL=mean(Uso.de.recursos.DL)) %>% 
  mutate(Uso.de.recursos.UL=mean(Uso.de.recursos.UL)) %>% 
  mutate(Paquetes.perdidos=mean(Paquetes.perdidos)) %>% 
  mutate(Accesos.de.0m.a.624m=mean(Accesos.de.0m.a.624m)) %>% 
  mutate(Accesos.de.702m.a.1.1Km=mean(Accesos.de.702m.a.1.1Km)) %>% 
  mutate(Accesos.de.1.1Km.a.2.1Km=mean(Accesos.de.1.1Km.a.2.1Km)) %>% 
  mutate(Accesos.2.1Km.a.3.5Km=mean(Accesos.2.1Km.a.3.5Km)) %>% 
  mutate(Accesos.a.mas.de.3.5Km=mean(Accesos.a.mas.de.3.5Km)) %>% 
  mutate(Trafico2.Descarga=mean(Trafico2.Descarga)) %>% 
  mutate(Trafico2.carga=mean(Trafico2.carga))
datos_4g_ACP<-unique(as.data.frame(datos_4g_ACP))

datos_4g_ACP<-sqldf("select * from datos_4g_ACP 
                    where `Accesibilidad.exitosa` <>0 
                    and `Accesibilidad.exitosa` < 99.97
                    and `Cantidad.de.usuarios`> 100
                    and `Uso.de.recursos.DL`> 15
                    and `Uso.de.recursos.UL`> 15
                    and `Trafico2.carga`> 3
                    and `Trafico2.Descarga`> 15
                    group by `Id.Celda` order by `Accesibilidad.exitosa` desc limit 5")
rownames(datos_4g_ACP)<-datos_4g_ACP$Id.Celda
datos_4g_ACP<-subset(datos_4g_ACP,select = -c(Id.Celda))

Generar un análisis de componentes principales para determinar la ‘fuerza’ de correlación que se da entre variables y los individuos seleccionados.

3G

pca.modelo_3g <- PCA(datos_3g_ACP, scale.unit = TRUE, ncp = 5, graph = FALSE)
Se comprueba atravéz de los gráficos de varianza que se debe de utilizar la 1ra y 2da componente para generar el ACP
fviz_eig(pca.modelo_3g, addlabels = TRUE, 
         ylab = 'Porcentaje de Varianzas Explicadas',
         xlab = 'Dimensiones', main = 'Varianza Explicada por cada eje')

corrplot(pca.modelo_3g$var$cor, is.corr=FALSE, mar=c(0,0,1,0), shade.col=NA,
         tl.col='black', addCoef.col='black', method='circle',
         title = 'Correlación de las variables con las componentes principales')

Se obtiene una inercia explicada del 69.7%, por lo que se puede interpretar que la calidad del gráfico es buena.
fviz_pca_biplot(pca.modelo_3g,col.var = "#2E9FDF",col.ind = "#696969",ggtheme = mi.tema,axes = c(1,2))

individuos_acp_3g<-fviz_cos2(pca.modelo_3g, choice = 'ind', axes = 1:2, top = 10,xtickslab.rt = 65) +
  labs(y = 'Cos2 - Calidad de la Representación',
       title = 'Cosenos cuadrados de los individuos')

4G

pca.modelo_4g <- PCA(datos_4g_ACP, scale.unit = TRUE, ncp = 5, graph = FALSE)
Se comprueba atravéz de los gráficos de varianza que se debe de utilizar la 1ra y 2da componente para generar el ACP
fviz_eig(pca.modelo_4g, addlabels = TRUE, 
         ylab = 'Porcentaje de Varianzas Explicadas',
         xlab = 'Dimensiones', main = 'Varianza Explicada por cada eje')

corrplot(pca.modelo_4g$var$cor, is.corr=FALSE, mar=c(0,0,1,0), shade.col=NA,
         tl.col='black', addCoef.col='black', method='circle',
         title = 'Correlación de las variables con las componentes principales')

Se obtiene una inercia explicada del 75.8%, por lo que se puede interpretar que la calidad del gráfico es buena.
fviz_pca_biplot(pca.modelo_4g,col.var = "#2E9FDF",col.ind = "#696969",ggtheme = mi.tema,axes = c(1,2))

individuos_acp_4g<-fviz_cos2(pca.modelo_4g, choice = 'ind', axes = 1:2, top = 10,xtickslab.rt = 65) +
  labs(y = 'Cos2 - Calidad de la Representación',
       title = 'Cosenos cuadrados de los individuos')

Se eliminan variables

remove(datos_3g_ACP,datos_4g_ACP)

Generar un test de normalidad para determinar si las variables a predecir de los individuos seleccionados siguen la distribución normal.

Test de normalidad bajo pruebas Pearson con un 5% de margen de error (significancia), además se verifica por medio de la distribución normal y por último se le aplica el test de por medio de qqnorm

Nota:No se aplican test de Kolmogorov-Smirnov, Cramer-von Mises"

Hipótesis: H0: La muestra proviene de una distribución normal, H1: La muestra no proviene de una distribución normal
Criterio de decisión:
  • Si P < Alfa :: H1
  • Si P >=Alfa :: H0
3G Trafico 1
celdas3g_candidatos<-matrix(nrow = 1,ncol = 5)
for (i in 1:5 ) {
  celdas<-row.names(pca.modelo_3g$ind$coord)[i]
  if (!is.na(celdas)){
    datos<-as.matrix(t(datos_3g %>% 
                       filter(Id.Celda==celdas)  %>% 
                       select(Trafico.1)))
  pruebas.pearson<-nortest::pearson.test(datos)
  if (pruebas.pearson$p.value >= 0.05){
    cat("La celda ",celdas," da como resultado en el test de pearson:",pruebas.pearson$p.value,", por lo tanto se puede afirmar que esta sigue la distribución normal, por lo tanto p>=0.05 , por lo tanto P=H0"," \n")
    
    h <- hist(datos, probability = T, main = paste("Análisis gráfico de normalidad:",row.names(pca.modelo_3g$ind$coord)[i],"Variable:",row.names(datos),"Tabla:",deparse(substitute(datos_3g)),sep = " "),xlab = "", ylab = "",col = "red")
    lines(density(datos,na.rm = T), lwd = 2, col = "green")
    mu <- mean(datos, na.rm = T)
    sigma <- sd(datos,na.rm = T)
    x <- seq(min(h$mids,na.rm = T), max(h$mids,na.rm = T), length = length(datos))
    y <- dnorm(x, mu, sigma)
    lines(x,y,lwd =2, col = "blue")
    qqnorm(datos,main = paste("Análisis gráfico de normalidad:",row.names(pca.modelo_3g$ind$coord)[i],"Variable:",row.names(datos),"Tabla:",deparse(substitute(datos_3g)),sep = " "))
    qqline(datos,col = "red")
    celdas3g_candidatos[1,i]<-c(celdas)
  }
  }
}
## La celda  W4102C1  da como resultado en el test de pearson: 0.5871054 , por lo tanto se puede afirmar que esta sigue la distribución normal, por lo tanto p>=0.05 , por lo tanto P=H0

3G Trafico 2
for (i in 1:5 ) {
  celdas<-row.names(pca.modelo_3g$ind$coord)[i]
  if (!is.na(celdas)){
    datos<-as.matrix(t(datos_3g %>% 
                       filter(Id.Celda==celdas)  %>% 
                       select(Trafico.2)))
  pruebas.pearson<-nortest::pearson.test(datos)
  if (pruebas.pearson$p.value >= 0.05){
    cat("La celda ",celdas," da como resultado en el test de pearson:",pruebas.pearson$p.value,", por lo tanto se puede afirmar que esta sigue la distribución normal, por lo tanto p>=0.05 , por lo tanto P=H0"," \n")  
    
    h <- hist(datos, probability = T, main = paste("Análisis gráfico de normalidad:",row.names(pca.modelo_3g$ind$coord)[i],"Variable:",row.names(datos),"Tabla:",deparse(substitute(datos_3g)),sep = " "),xlab = "", ylab = "",col = "red")
    lines(density(datos,na.rm = T), lwd = 2, col = "green")
    mu <- mean(datos, na.rm = T)
    sigma <- sd(datos,na.rm = T)
    x <- seq(min(h$mids,na.rm = T), max(h$mids,na.rm = T), length = length(datos))
    y <- dnorm(x, mu, sigma)
    lines(x,y,lwd =2, col = "blue")
    qqnorm(datos,main = paste("Análisis gráfico de normalidad:",row.names(pca.modelo_3g$ind$coord)[i],"Variable:",row.names(datos),"Tabla:",deparse(substitute(datos_3g)),sep = " "))
    qqline(datos,col = "red")
    if (is.na(celdas3g_candidatos[1,i])){
    celdas3g_candidatos[1,i]<-c(celdas)  
    }else{
      if (i==5){
      celdas3g_candidatos[1,i-1]<-c(celdas)  
      }else{
      celdas3g_candidatos[1,i+1]<-c(celdas)    
      }
    }
    
  }
  }
  
}
## La celda  W3005A1  da como resultado en el test de pearson: 0.05244831 , por lo tanto se puede afirmar que esta sigue la distribución normal, por lo tanto p>=0.05 , por lo tanto P=H0

## La celda  W4102C1  da como resultado en el test de pearson: 0.176469 , por lo tanto se puede afirmar que esta sigue la distribución normal, por lo tanto p>=0.05 , por lo tanto P=H0

## La celda  W4122C3  da como resultado en el test de pearson: 0.5575399 , por lo tanto se puede afirmar que esta sigue la distribución normal, por lo tanto p>=0.05 , por lo tanto P=H0

4G Descarga
celdas4g_candidatos<-matrix(nrow = 1,ncol = 5)
for (i in 1:5 ) {
  celdas<-row.names(pca.modelo_4g$ind$coord)[i]
  if (!is.na(celdas)){
   datos<-as.matrix(t(datos_4g %>% 
                       filter(Id.Celda==celdas)  %>% 
                       select(Trafico2.Descarga)))
  pruebas.pearson<-nortest::pearson.test(datos)
  if (pruebas.pearson$p.value >= 0.05){
    cat("La celda ",celdas," da como resultado en el test de pearson:",pruebas.pearson$p.value,", por lo tanto se puede afirmar que esta sigue la distribución normal, por lo tanto p>=0.05 , por lo tanto P=H0"," \n")  
    
    h <- hist(datos, probability = T, main = paste("Análisis gráfico de normalidad:",row.names(pca.modelo_4g$ind$coord)[i],"Variable:",row.names(datos),"Tabla:",deparse(substitute(datos_4g)),sep = " "),xlab = "", ylab = "",col = "red")
    lines(density(datos,na.rm = T), lwd = 2, col = "green")
    mu <- mean(datos, na.rm = T)
    sigma <- sd(datos,na.rm = T)
    x <- seq(min(h$mids,na.rm = T), max(h$mids,na.rm = T), length = length(datos))
    y <- dnorm(x, mu, sigma)
    lines(x,y,lwd =2, col = "blue")
    qqnorm(datos,main = paste("Análisis gráfico de normalidad:",row.names(pca.modelo_4g$ind$coord)[i],"Variable:",row.names(datos),"Tabla:",deparse(substitute(datos_4g)),sep = " "))
    qqline(datos,col = "red")
    celdas4g_candidatos[1,i]<-c(celdas)
  } 
  }
}
## La celda  L07202175A2  da como resultado en el test de pearson: 0.1244225 , por lo tanto se puede afirmar que esta sigue la distribución normal, por lo tanto p>=0.05 , por lo tanto P=H0

## La celda  L03151199A1  da como resultado en el test de pearson: 0.8800701 , por lo tanto se puede afirmar que esta sigue la distribución normal, por lo tanto p>=0.05 , por lo tanto P=H0

4G carga
for (i in 1:5 ) {
  celdas<-row.names(pca.modelo_4g$ind$coord)[i]
  if (!is.na(celdas)){
   datos<-as.matrix(t(datos_4g %>% 
                       filter(Id.Celda==celdas)  %>% 
                       select(Trafico2.carga)))
  pruebas.pearson<-nortest::pearson.test(datos)
  if (pruebas.pearson$p.value >= 0.05){
    cat("La celda ",celdas," da como resultado en el test de pearson:",pruebas.pearson$p.value,", por lo tanto se puede afirmar que esta sigue la distribución normal, por lo tanto p>=0.05 , por lo tanto P=H0"," \n")  
    
    h <- hist(datos, probability = T, main = paste("Análisis gráfico de normalidad:",row.names(pca.modelo_4g$ind$coord)[i],"Variable:",row.names(datos),"Tabla:",deparse(substitute(datos_4g)),sep = " "),xlab = "", ylab = "",col = "red")
    lines(density(datos,na.rm = T), lwd = 2, col = "green")
    mu <- mean(datos, na.rm = T)
    sigma <- sd(datos,na.rm = T)
    x <- seq(min(h$mids,na.rm = T), max(h$mids,na.rm = T), length = length(datos))
    y <- dnorm(x, mu, sigma)
    lines(x,y,lwd =2, col = "blue")
    qqnorm(datos,main = paste("Análisis gráfico de normalidad:",row.names(pca.modelo_4g$ind$coord)[i],"Variable:",row.names(datos),"Tabla:",deparse(substitute(datos_4g)),sep = " "))
    qqline(datos,col = "red")
    if (is.na(celdas4g_candidatos[1,i])){
    celdas4g_candidatos[1,i]<-c(celdas)  
    }else{
      if (i==5){
      celdas4g_candidatos[1,i-1]<-c(celdas)  
      }else{
      celdas4g_candidatos[1,i+1]<-c(celdas)    
      }
    }
  } 
  }
  
}
## La celda  L07201080A2  da como resultado en el test de pearson: 0.07425654 , por lo tanto se puede afirmar que esta sigue la distribución normal, por lo tanto p>=0.05 , por lo tanto P=H0

Los candidatos a aplicarles las series de tiempo son:
as.data.frame(unique(as.list(celdas3g_candidatos)))
ABCDEFGHIJ0123456789
X.W3005A1.
<fctr>
X.W4102C1.
<fctr>
X.W4122C3.
<fctr>
NA_character_.
<fctr>
W3005A1W4102C1W4122C3NA
as.data.frame(unique(as.list(celdas4g_candidatos)))
ABCDEFGHIJ0123456789
X.L07202175A2.
<fctr>
NA_character_.
<fctr>
X.L03151199A1.
<fctr>
X.L07201080A2.
<fctr>
L07202175A2NAL03151199A1L07201080A2

Observar las atipicidades de los individuos selecionados.

atipicidad("3G",datos_3g,as.list(celdas3g_candidatos))

atipicidad("4G",datos_4g,as.list(celdas4g_candidatos))

Generar un suavizado para la información con el fin de eliminar datos atípicos.

suavizado("3G",datos_3g,as.list(celdas3g_candidatos))

suavizado("4G",datos_4g,as.list(celdas4g_candidatos))

Generar peridiogramas para observar atravez de la frecuencia del tiempo cada cuanto se producen eventos de importancia en los individuos.

3G Tráfico 1

#periodiograma("3G",datos_3g,as.list(celdas3g_candidatos))
#periodiograma("4G",datos_4g,as.list(celdas4g_candidatos))

dato<-sqldf(sprintf("select `Fecha`,`Id.Celda`,avg(`Trafico.1`) as `Trafico.1`,avg(`Trafico.2`) as `Trafico.2` 
                          from datos_3g where `Id.Celda`= '%s' group by `Fecha`", as.character(celdas3g_candidatos[1])))
      datos_periodigrama_3g_trafico_1<-ts(rev(dato$Trafico.1),start = c(lubridate::year(dato$Fecha)[1],yday(dato$Fecha)[1]),frequency = 365)
      res<-spec.pgram(datos_periodigrama_3g_trafico_1)
      order(res$spec,res$freq,decreasing = TRUE)
##  [1]  1 27  2  7 55  4  8 82 28 29 12 14  3  5 19  6 18  9 83 54 26 16 11
## [24] 47 22 24 30 34 84 66 51 40 52 31 65 57 81 88 49 25 74 41 43 21 48 77
## [47] 64 89 95 38 80 53 39 44 13 36 61 42 78 87 23 63 37 85 10 75 60 79 35
## [70] 33 70 59 58 20 91 69 67 62 92 32 50 72 15 94 45 90 93 46 68 56 86 76
## [93] 17 73 71 96
      max1<-res$freq[27]
      max2<-res$freq[7]
      max3<-res$freq[55]
      abline(v=max1, lty="dotted",col="red")
      abline(v=max2, lty="dotted",col="blue")
      abline(v=max3, lty="dotted",col="magenta")

      periodo1 <- 365/max1
      periodo2 <- 365/max2
      periodo3 <- 365/max3

paste(round(periodo1),round(periodo2),round(periodo3),sep = ",")
## [1] "7,27,3"

3G Tráfico 2

      datos_periodigrama_3g_trafico_2<-ts(rev(dato$Trafico.2),start = c(lubridate::year(dato$Fecha)[1],yday(dato$Fecha)[1]),frequency = 365)
      res<-spec.pgram(datos_periodigrama_3g_trafico_2)
      order(res$spec,res$freq,decreasing = TRUE)
##  [1]  2 55  5  6 38  1  7 50 27 57 11 12 37 56 71 28 13 60  9  4 93 40 65
## [24] 41 23 82 10 81 49 54 53 17 29 78 83 77 58 14 59 26 84 24 63 43 34 19
## [47] 33 46 69 39 72 74 35 67 91  3 61 51  8 32 80 70 73 45 21 18 36 30 85
## [70] 66 76 47 52 20 68 42 62 16 94 48 92 15 64 88 75 31 89 95 86 25 87 96
## [93] 90 79 44 22
      max1<-res$freq[55]
      max2<-res$freq[5]
      max3<-res$freq[6]
      abline(v=max1, lty="dotted",col="red")
      abline(v=max2, lty="dotted",col="blue")
      abline(v=max3, lty="dotted",col="magenta")

      periodo1 <- 365/max1
      periodo2 <- 365/max2
      periodo3 <- 365/max3

paste(round(periodo1),round(periodo2),round(periodo3),sep = ",")
## [1] "3,38,32"

4G Tráfico carga

dato<-sqldf(sprintf("select `Fecha`,`Id.Celda`,avg(`Trafico2.carga`) as `Trafico2.carga`,avg(`Trafico2.Descarga`) as `Trafico2.Descarga` 
                          from datos_4g where `Id.Celda`= '%s' group by `Fecha`", as.character(celdas4g_candidatos[5])))
      datos_periodigrama_4g_trafico2_carga<-ts(rev(dato$Trafico2.carga),start = c(lubridate::year(dato$Fecha)[1],yday(dato$Fecha)[1]),frequency = 365)
      res<-spec.pgram(datos_periodigrama_4g_trafico2_carga)
      order(res$spec,res$freq,decreasing = TRUE)
##  [1]  1 28  2 55 27  3 19  6 25  7 39  4 11 18 16 54 85 17 92 96 61  9 50
## [24]  5 63 46 40 30 66 41 23 47 43 37 76 20 32 49 67 56 95 33 94 79 77 93
## [47] 71 12 80 86 13  8 51 64 35 60 65 38 81 62 57 69 90 34 42 68 82 53 26
## [70] 74 24 78 91 84 75 73 48 70 45 14 31 36 87 52 10 15 83 29 89 44 21 22
## [93] 59 58 72 88
      max1<-res$freq[28]
      max2<-res$freq[55]
      max3<-res$freq[27]
      abline(v=max1, lty="dotted",col="red")
      abline(v=max2, lty="dotted",col="blue")
      abline(v=max3, lty="dotted",col="magenta")

      periodo1 <- 365/max1
      periodo2 <- 365/max2
      periodo3 <- 365/max3

paste(round(periodo1),round(periodo2),round(periodo3),sep = ",")
## [1] "7,3,7"

4G Tráfico descarga

      datos_periodigrama_4g_trafico2_descarga<-ts(rev(dato$Trafico2.Descarga),start = c(lubridate::year(dato$Fecha)[1],yday(dato$Fecha)[1]),frequency = 365)
      res<-spec.pgram(datos_periodigrama_4g_trafico2_descarga)
      order(res$spec,res$freq,decreasing = TRUE)
##  [1] 27 28 55 25  6  1 54 30 82 19  3  7 56 50 29 10  2  9 38 37 47 12 11
## [24] 69 13 17 36 43 75 22 77  5 23 32 16 60 95 72 51 18 21 83 39 71 59 85
## [47] 79 58 90 92 41 52 65 48 46  4 66 80 45 68 64 53 86 42 67 44 24 93 33
## [70] 87 40  8 84 88 70 34 57 49 20 76 89 14 73 81 91 61 74 62 26 96 63 94
## [93] 78 35 31 15
      max1<-res$freq[28]
      max2<-res$freq[55]
      max3<-res$freq[25]
      abline(v=max1, lty="dotted",col="red")
      abline(v=max2, lty="dotted",col="blue")
      abline(v=max3, lty="dotted",col="magenta")

      periodo1 <- 365/max1
      periodo2 <- 365/max2
      periodo3 <- 365/max3

paste(round(periodo1),round(periodo2),round(periodo3),sep = ",")
## [1] "7,3,8"

4.Evaluar el modelo

Desarrollar mediciones de error utilizando los algoritmos de Box-Jenkings para determinar que método se va a utilizar en las predicciones de los individuos.

Nota: Debido a que el método de Holtwinters requiere como mínimo 2 periodos adicionales (2 años) , se generan errores por no cumplir este requisito, por lo que no se utilizará este método.

3G Trafico 1 candidato 1

celda<-sqldf(sprintf("select `Fecha`,`Id.Celda`,`Trafico.1`,`Trafico.2` 
                           from datos_3g where `Id.Celda`= '%s' group by `Fecha`", as.character(as.list(celdas3g_candidatos[[1]][1]))))

celda.aprende<-celda[1:round(dim(celda)[1]*0.8),]
celda.test<-celda[as.numeric(round((dim(celda)[1])*0.8)+1):as.numeric(dim(celda)[1]),]
celda.aprende.serie<-ts(celda.aprende$Trafico.1,start = c(lubridate::year(celda.aprende$Fecha)[1],yday(celda.aprende$Fecha)[1]),frequency = 365)
ARIMA_NUMEROS<-paste(auto.arima(celda.aprende.serie))
ARIMA_NUMEROS<-str_extract_all(ARIMA_NUMEROS,"[[:digit:]]")
modelo<-arima(celda.aprende.serie,order = c(as.numeric(ARIMA_NUMEROS[[1]][1]),as.numeric(ARIMA_NUMEROS[[1]][2]),as.numeric(ARIMA_NUMEROS[[1]][3])))
pred.arima<-predict(modelo,n.ahead = dim(celda.test)[1])

er<-ER(pred.arima$pred,celda.test$Trafico.1)
pfa<-PFA(pred.arima$pred,celda.test$Trafico.1)
ptfa<-PTFA(pred.arima$pred,celda.test$Trafico.1)
recm<-RECM(pred.arima$pred,celda.test$Trafico.1)
err<-c(er,pfa,ptfa,recm)


celda.aprende<-celda[1:round(dim(celda)[1]*0.8),]
celda.test<-celda[as.numeric(round((dim(celda)[1])*0.8)+1):as.numeric(dim(celda)[1]),]
res<-spec.pgram(celda$Trafico.1, log = "no",plot = FALSE)
conteo<-0
for (a in 2:length(order(res$spec,res$freq,decreasing = TRUE))) {
  if(order(res$spec,res$freq,decreasing = TRUE)[a]>2 && conteo < 1){
    max<-res$freq[order(res$spec,res$freq,decreasing = TRUE)[a]]
    periodo<-365/max
    conteo=1
    break()
  }
}
ARIMA_NUMEROS<-calibrar.arima(celda.aprende$Trafico.1,celda.test$Trafico.1,periodo)
celda.aprende.serie<-ts(celda.aprende$Trafico.1,start = c(lubridate::year(celda.aprende$Fecha)[1],yday(celda.aprende$Fecha)[1]),frequency = 365)
tryCatch(modelo <- arima(celda.aprende.serie, order = c(ARIMA_NUMEROS$call$order[1],ARIMA_NUMEROS$call$order[2],ARIMA_NUMEROS$call$order[3]),
                         seasonal = list(order = c(ARIMA_NUMEROS$call$seasonal$order[1],ARIMA_NUMEROS$call$seasonal$order[2],ARIMA_NUMEROS$call$seasonal$order[3]),
                                         period = as.double(ARIMA_NUMEROS$call$seasonal$period))),
         finally = modelo <- arima(celda.aprende.serie, order = c(ARIMA_NUMEROS$call$order[1],ARIMA_NUMEROS$call$order[2],ARIMA_NUMEROS$call$order[3])))
pred.arima.calibrado <- predict(modelo, n.ahead = (as.numeric(dim(celda)[1])-as.numeric(round((dim(celda)[1])*0.8)+1))+1)
er2   <- ER(pred.arima.calibrado$pred, celda.test$Trafico.1)
pfa2  <- PFA(pred.arima.calibrado$pred,celda.test$Trafico.1)
ptfa2 <- PTFA(pred.arima.calibrado$pred,celda.test$Trafico.1)
recm2 <- RECM(pred.arima.calibrado$pred,celda.test$Trafico.1)
err2 <- c(er2, pfa2, ptfa2, recm2)



celda<-sqldf(sprintf("select `Fecha`,`Id.Celda`,`Trafico.1`,`Trafico.2` 
                           from datos_3g where `Id.Celda`= '%s' group by `Fecha`", as.character(as.list(celdas3g_candidatos[[1]][1]))))

rownames(celda)<-celda$Fecha
celda<-select(celda,-c(Fecha,Id.Celda))
celda<-suavizar.serie(celda,n=3)
celda.aprende<-celda[1:round(dim(celda)[1]*0.8),]
celda.test<-celda[as.numeric(round((dim(celda)[1])*0.8)+1):as.numeric(dim(celda)[1]),]
celda.aprende.serie<-ts(celda.aprende$Trafico.1,start = c(lubridate::year(rownames(celda.aprende))[1],yday(rownames(celda.aprende))[1]),frequency = 365)
ARIMA_NUMEROS<-paste(auto.arima(celda.aprende.serie))
ARIMA_NUMEROS<-str_extract_all(ARIMA_NUMEROS,"[[:digit:]]")
modelo<-arima(celda.aprende.serie,order = c(as.numeric(ARIMA_NUMEROS[[1]][1]),as.numeric(ARIMA_NUMEROS[[1]][2]),as.numeric(ARIMA_NUMEROS[[1]][3])))
pred.arima<-predict(modelo,n.ahead = dim(celda.test)[1])

er3<-ER(pred.arima$pred,celda.test$Trafico.1)
pfa3<-PFA(pred.arima$pred,celda.test$Trafico.1)
ptfa3<-PTFA(pred.arima$pred,celda.test$Trafico.1)
recm3<-RECM(pred.arima$pred,celda.test$Trafico.1)
err3<-c(er3,pfa3,ptfa3,recm3)


celda.aprende<-celda[1:round(dim(celda)[1]*0.8),]
celda.test<-celda[as.numeric(round((dim(celda)[1])*0.8)+1):as.numeric(dim(celda)[1]),]
res<-spec.pgram(celda$Trafico.1, log = "no",plot = FALSE)
conteo<-0
for (a in 2:length(order(res$spec,res$freq,decreasing = TRUE))) {
  if(order(res$spec,res$freq,decreasing = TRUE)[a]>2 && conteo < 1){
    max<-res$freq[order(res$spec,res$freq,decreasing = TRUE)[a]]
    periodo<-365/max
    conteo=1
    break()
  }
}
ARIMA_NUMEROS<-calibrar.arima(celda.aprende$Trafico.1,celda.test$Trafico.1,periodo)
celda.aprende.serie<-ts(celda.aprende$Trafico.1,start = c(lubridate::year(rownames(celda.aprende))[1],yday(rownames(celda.aprende))[1]),frequency = 365)
modelo <- arima(celda.aprende.serie, order = c(ARIMA_NUMEROS$call$order[1],ARIMA_NUMEROS$call$order[2],ARIMA_NUMEROS$call$order[3]),
                         seasonal = list(order = c(ARIMA_NUMEROS$call$seasonal$order[1],ARIMA_NUMEROS$call$seasonal$order[2],ARIMA_NUMEROS$call$seasonal$order[3]),
                                         period = as.double(ARIMA_NUMEROS$call$seasonal$period)),optim.control = list(maxit = 1000))
pred.arima.calibrado <- predict(modelo, n.ahead = (as.numeric(dim(celda)[1])-as.numeric(round((dim(celda)[1])*0.8)+1))+1)
er4   <- ER(pred.arima.calibrado$pred, celda.test$Trafico.1)
pfa4  <- PFA(pred.arima.calibrado$pred,celda.test$Trafico.1)
ptfa4 <- PTFA(pred.arima.calibrado$pred,celda.test$Trafico.1)
recm4 <- RECM(pred.arima.calibrado$pred,celda.test$Trafico.1)
err4 <- c(er4, pfa4, ptfa4, recm4)

errores <- rbind(err,err2,err3,err4)
rownames(errores) <- c("Errores Box-Jenkings no calibrado","Errores Box-Jenkings calibrado","Errores Box-Jenkings no calibrado.suavizado","Errores Box-Jenkings calibrado.suavizado")
colnames(errores) <- c("ER","PFA","PTFA","RECM")
centros.radar(errores)

3G Trafico 2 candidato 1

celda<-sqldf(sprintf("select `Fecha`,`Id.Celda`,`Trafico.1`,`Trafico.2` 
                           from datos_3g where `Id.Celda`= '%s' group by `Fecha`", as.character(as.list(celdas3g_candidatos[[1]][1]))))

celda.aprende<-celda[1:round(dim(celda)[1]*0.8),]
celda.test<-celda[as.numeric(round((dim(celda)[1])*0.8)+1):as.numeric(dim(celda)[1]),]
celda.aprende.serie<-ts(celda.aprende$Trafico.2,start = c(lubridate::year(celda.aprende$Fecha)[1],yday(celda.aprende$Fecha)[1]),frequency = 365)
ARIMA_NUMEROS<-paste(auto.arima(celda.aprende.serie))
ARIMA_NUMEROS<-str_extract_all(ARIMA_NUMEROS,"[[:digit:]]")
modelo<-arima(celda.aprende.serie,order = c(as.numeric(ARIMA_NUMEROS[[1]][1]),as.numeric(ARIMA_NUMEROS[[1]][2]),as.numeric(ARIMA_NUMEROS[[1]][3])))
pred.arima<-predict(modelo,n.ahead = dim(celda.test)[1])

er<-ER(pred.arima$pred,celda.test$Trafico.2)
pfa<-PFA(pred.arima$pred,celda.test$Trafico.2)
ptfa<-PTFA(pred.arima$pred,celda.test$Trafico.2)
recm<-RECM(pred.arima$pred,celda.test$Trafico.2)
err<-c(er,pfa,ptfa,recm)


celda.aprende<-celda[1:round(dim(celda)[1]*0.8),]
celda.test<-celda[as.numeric(round((dim(celda)[1])*0.8)+1):as.numeric(dim(celda)[1]),]
res<-spec.pgram(celda$Trafico.2, log = "no",plot = FALSE)
conteo<-0
for (a in 2:length(order(res$spec,res$freq,decreasing = TRUE))) {
  if(order(res$spec,res$freq,decreasing = TRUE)[a]>2 && conteo < 1){
    max<-res$freq[order(res$spec,res$freq,decreasing = TRUE)[a]]
    periodo<-365/max
    conteo=1
    break()
  }
}
ARIMA_NUMEROS<-calibrar.arima(celda.aprende$Trafico.2,celda.test$Trafico.2,periodo)
celda.aprende.serie<-ts(celda.aprende$Trafico.2,start = c(lubridate::year(celda.aprende$Fecha)[1],yday(celda.aprende$Fecha)[1]),frequency = 365)
tryCatch(modelo <- arima(celda.aprende.serie, order = c(ARIMA_NUMEROS$call$order[1],ARIMA_NUMEROS$call$order[2],ARIMA_NUMEROS$call$order[3]),
                         seasonal = list(order = c(ARIMA_NUMEROS$call$seasonal$order[1],ARIMA_NUMEROS$call$seasonal$order[2],ARIMA_NUMEROS$call$seasonal$order[3]),
                                         period = as.double(ARIMA_NUMEROS$call$seasonal$period))),
         finally = modelo <- arima(celda.aprende.serie, order = c(ARIMA_NUMEROS$call$order[1],ARIMA_NUMEROS$call$order[2],ARIMA_NUMEROS$call$order[3])))
pred.arima.calibrado <- predict(modelo, n.ahead = (as.numeric(dim(celda)[1])-as.numeric(round((dim(celda)[1])*0.8)+1))+1)
er2   <- ER(pred.arima.calibrado$pred, celda.test$Trafico.2)
pfa2  <- PFA(pred.arima.calibrado$pred,celda.test$Trafico.2)
ptfa2 <- PTFA(pred.arima.calibrado$pred,celda.test$Trafico.2)
recm2 <- RECM(pred.arima.calibrado$pred,celda.test$Trafico.2)
err2 <- c(er2, pfa2, ptfa2, recm2)

celda<-sqldf(sprintf("select `Fecha`,`Id.Celda`,`Trafico.1`,`Trafico.2` 
                           from datos_3g where `Id.Celda`= '%s' group by `Fecha`", as.character(as.list(celdas3g_candidatos[[1]][1]))))

rownames(celda)<-celda$Fecha
celda<-select(celda,-c(Fecha,Id.Celda))
celda<-suavizar.serie(celda,n=3)
celda.aprende<-celda[1:round(dim(celda)[1]*0.8),]
celda.test<-celda[as.numeric(round((dim(celda)[1])*0.8)+1):as.numeric(dim(celda)[1]),]
celda.aprende.serie<-ts(celda.aprende$Trafico.2,start = c(lubridate::year(rownames(celda.aprende))[1],yday(rownames(celda.aprende))[1]),frequency = 365)
ARIMA_NUMEROS<-paste(auto.arima(celda.aprende.serie))
ARIMA_NUMEROS<-str_extract_all(ARIMA_NUMEROS,"[[:digit:]]")
modelo<-arima(celda.aprende.serie,order = c(as.numeric(ARIMA_NUMEROS[[1]][1]),as.numeric(ARIMA_NUMEROS[[1]][2]),as.numeric(ARIMA_NUMEROS[[1]][3])))
pred.arima<-predict(modelo,n.ahead = dim(celda.test)[1])

er3<-ER(pred.arima$pred,celda.test$Trafico.2)
pfa3<-PFA(pred.arima$pred,celda.test$Trafico.2)
ptfa3<-PTFA(pred.arima$pred,celda.test$Trafico.2)
recm3<-RECM(pred.arima$pred,celda.test$Trafico.2)
err3<-c(er3,pfa3,ptfa3,recm3)


celda.aprende<-celda[1:round(dim(celda)[1]*0.8),]
celda.test<-celda[as.numeric(round((dim(celda)[1])*0.8)+1):as.numeric(dim(celda)[1]),]
res<-spec.pgram(celda$Trafico.2, log = "no",plot = FALSE)
conteo<-0
for (a in 2:length(order(res$spec,res$freq,decreasing = TRUE))) {
  if(order(res$spec,res$freq,decreasing = TRUE)[a]>2 && conteo < 1){
    max<-res$freq[order(res$spec,res$freq,decreasing = TRUE)[a]]
    periodo<-365/max
    conteo=1
    break()
  }
}
ARIMA_NUMEROS<-calibrar.arima(celda.aprende$Trafico.2,celda.test$Trafico.2,periodo)
celda.aprende.serie<-ts(celda.aprende$Trafico.2,start = c(lubridate::year(rownames(celda.aprende))[1],yday(rownames(celda.aprende))[1]),frequency = 365)
tryCatch(modelo <- arima(celda.aprende.serie, order = c(ARIMA_NUMEROS$call$order[1],ARIMA_NUMEROS$call$order[2],ARIMA_NUMEROS$call$order[3]),
                         seasonal = list(order = c(ARIMA_NUMEROS$call$seasonal$order[1],ARIMA_NUMEROS$call$seasonal$order[2],ARIMA_NUMEROS$call$seasonal$order[3]),
                                         period = as.double(ARIMA_NUMEROS$call$seasonal$period))),
         finally = modelo <- arima(celda.aprende.serie, order = c(ARIMA_NUMEROS$call$order[1],ARIMA_NUMEROS$call$order[2],ARIMA_NUMEROS$call$order[3])))
pred.arima.calibrado <- predict(modelo, n.ahead = (as.numeric(dim(celda)[1])-as.numeric(round((dim(celda)[1])*0.8)+1))+1)
er4   <- ER(pred.arima.calibrado$pred, celda.test$Trafico.2)
pfa4  <- PFA(pred.arima.calibrado$pred,celda.test$Trafico.2)
ptfa4 <- PTFA(pred.arima.calibrado$pred,celda.test$Trafico.2)
recm4 <- RECM(pred.arima.calibrado$pred,celda.test$Trafico.2)
err4 <- c(er4, pfa4, ptfa4, recm4)

errores <- rbind(err,err2,err3,err4)
rownames(errores) <- c("Errores Box-Jenkings no calibrado","Errores Box-Jenkings calibrado","Errores Box-Jenkings no calibrado.suavizado","Errores Box-Jenkings calibrado.suavizado")
colnames(errores) <- c("ER","PFA","PTFA","RECM")
centros.radar(errores)

4G Trafico 2.carga candidato 1

celda<-sqldf(sprintf("select `Fecha`,`Id.Celda`,`Trafico2.carga`,`Trafico2.Descarga` 
                           from datos_4g where `Id.Celda`= '%s' group by `Fecha`", as.character(as.list(celdas4g_candidatos[[5]][1]))))
celda.aprende<-celda[1:round(dim(celda)[1]*0.8),]
celda.test<-celda[as.numeric(round((dim(celda)[1])*0.8)+1):as.numeric(dim(celda)[1]),]
celda.aprende.serie<-ts(celda.aprende$Trafico2.carga,start = c(lubridate::year(celda.aprende$Fecha)[1],yday(celda.aprende$Fecha)[1]),frequency = 365)
ARIMA_NUMEROS<-paste(auto.arima(celda.aprende.serie))
ARIMA_NUMEROS<-str_extract_all(ARIMA_NUMEROS,"[[:digit:]]")
modelo<-arima(celda.aprende.serie,order = c(as.numeric(ARIMA_NUMEROS[[1]][1]),as.numeric(ARIMA_NUMEROS[[1]][2]),as.numeric(ARIMA_NUMEROS[[1]][3])))
pred.arima<-predict(modelo,n.ahead = dim(celda.test)[1])

er<-ER(pred.arima$pred,celda.test$Trafico2.carga)
pfa<-PFA(pred.arima$pred,celda.test$Trafico2.carga)
ptfa<-PTFA(pred.arima$pred,celda.test$Trafico2.carga)
recm<-RECM(pred.arima$pred,celda.test$Trafico2.carga)
err<-c(er,pfa,ptfa,recm)


celda.aprende<-celda[1:round(dim(celda)[1]*0.8),]
celda.test<-celda[as.numeric(round((dim(celda)[1])*0.8)+1):as.numeric(dim(celda)[1]),]
res<-spec.pgram(celda$Trafico2.carga, log = "no",plot = FALSE)
conteo<-0
for (a in 2:length(order(res$spec,res$freq,decreasing = TRUE))) {
  if(order(res$spec,res$freq,decreasing = TRUE)[a]>2 && conteo < 1){
    max<-res$freq[order(res$spec,res$freq,decreasing = TRUE)[a]]
    periodo<-365/max
    conteo=1
    break()
  }
}
ARIMA_NUMEROS<-calibrar.arima(celda.aprende$Trafico2.carga,celda.test$Trafico2.carga,periodo)
celda.aprende.serie<-ts(celda.aprende$Trafico2.carga,start = c(lubridate::year(celda.aprende$Fecha)[1],yday(celda.aprende$Fecha)[1]),frequency = 365)
tryCatch(modelo <- arima(celda.aprende.serie, order = c(ARIMA_NUMEROS$call$order[1],ARIMA_NUMEROS$call$order[2],ARIMA_NUMEROS$call$order[3]),
                         seasonal = list(order = c(ARIMA_NUMEROS$call$seasonal$order[1],ARIMA_NUMEROS$call$seasonal$order[2],ARIMA_NUMEROS$call$seasonal$order[3]),
                                         period = as.double(ARIMA_NUMEROS$call$seasonal$period))),
         finally = modelo <- arima(celda.aprende.serie, order = c(ARIMA_NUMEROS$call$order[1],ARIMA_NUMEROS$call$order[2],ARIMA_NUMEROS$call$order[3])))
pred.arima.calibrado <- predict(modelo, n.ahead = (as.numeric(dim(celda)[1])-as.numeric(round((dim(celda)[1])*0.8)+1))+1)
er2   <- ER(pred.arima.calibrado$pred, celda.test$Trafico2.carga)
pfa2  <- PFA(pred.arima.calibrado$pred,celda.test$Trafico2.carga)
ptfa2 <- PTFA(pred.arima.calibrado$pred,celda.test$Trafico2.carga)
recm2 <- RECM(pred.arima.calibrado$pred,celda.test$Trafico2.carga)
err2 <- c(er2, pfa2, ptfa2, recm2)

celda<-sqldf(sprintf("select `Fecha`,`Id.Celda`,`Trafico2.carga`,`Trafico2.Descarga` 
                           from datos_4g where `Id.Celda`= '%s' group by `Fecha`", as.character(as.list(celdas4g_candidatos[[5]][1]))))

rownames(celda)<-celda$Fecha
celda<-select(celda,-c(Fecha,Id.Celda))
celda<-suavizar.serie(celda,n=5)
celda.aprende<-celda[1:round(dim(celda)[1]*0.8),]
celda.test<-celda[as.numeric(round((dim(celda)[1])*0.8)+1):as.numeric(dim(celda)[1]),]
celda.aprende.serie<-ts(celda.aprende$Trafico2.carga,start = c(lubridate::year(rownames(celda.aprende))[1],yday(rownames(celda.aprende))[1]),frequency = 365)
ARIMA_NUMEROS<-paste(auto.arima(celda.aprende.serie))
ARIMA_NUMEROS<-str_extract_all(ARIMA_NUMEROS,"[[:digit:]]")
modelo<-arima(celda.aprende.serie,order = c(as.numeric(ARIMA_NUMEROS[[1]][1]),as.numeric(ARIMA_NUMEROS[[1]][2]),as.numeric(ARIMA_NUMEROS[[1]][3])))
pred.arima<-predict(modelo,n.ahead = dim(celda.test)[1])

er3<-ER(pred.arima$pred,celda.test$Trafico2.carga)
pfa3<-PFA(pred.arima$pred,celda.test$Trafico2.carga)
ptfa3<-PTFA(pred.arima$pred,celda.test$Trafico2.carga)
recm3<-RECM(pred.arima$pred,celda.test$Trafico2.carga)
err3<-c(er3,pfa3,ptfa3,recm3)


celda.aprende<-celda[1:round(dim(celda)[1]*0.8),]
celda.test<-celda[as.numeric(round((dim(celda)[1])*0.8)+1):as.numeric(dim(celda)[1]),]
res<-spec.pgram(celda$Trafico2.carga, log = "no",plot = FALSE)
conteo<-0
for (a in 2:length(order(res$spec,res$freq,decreasing = TRUE))) {
  if(order(res$spec,res$freq,decreasing = TRUE)[a]>2 && conteo < 1){
    max<-res$freq[order(res$spec,res$freq,decreasing = TRUE)[a]]
    periodo<-365/max
    conteo=1
    break()
  }
}
ARIMA_NUMEROS<-calibrar.arima(celda.aprende$Trafico2.carga,celda.test$Trafico2.carga,periodo)
celda.aprende.serie<-ts(celda.aprende$Trafico2.carga,start = c(lubridate::year(rownames(celda.aprende))[1],yday(rownames(celda.aprende))[1]),frequency = 365)
tryCatch(modelo <- arima(celda.aprende.serie, order = c(ARIMA_NUMEROS$call$order[1],ARIMA_NUMEROS$call$order[2],ARIMA_NUMEROS$call$order[3]),
                         seasonal = list(order = c(ARIMA_NUMEROS$call$seasonal$order[1],ARIMA_NUMEROS$call$seasonal$order[2],ARIMA_NUMEROS$call$seasonal$order[3]),
                                         period = as.double(ARIMA_NUMEROS$call$seasonal$period))),
         finally = modelo <- arima(celda.aprende.serie, order = c(ARIMA_NUMEROS$call$order[1],ARIMA_NUMEROS$call$order[2],ARIMA_NUMEROS$call$order[3])))
pred.arima.calibrado <- predict(modelo, n.ahead = (as.numeric(dim(celda)[1])-as.numeric(round((dim(celda)[1])*0.8)+1))+1)
er4   <- ER(pred.arima.calibrado$pred, celda.test$Trafico2.carga)
pfa4  <- PFA(pred.arima.calibrado$pred,celda.test$Trafico2.carga)
ptfa4 <- PTFA(pred.arima.calibrado$pred,celda.test$Trafico2.carga)
recm4 <- RECM(pred.arima.calibrado$pred,celda.test$Trafico2.carga)
err4 <- c(er4, pfa4, ptfa4, recm4)

errores <- rbind(err,err2,err3,err4)
rownames(errores) <- c("Errores Box-Jenkings no calibrado","Errores Box-Jenkings calibrado","Errores Box-Jenkings no calibrado.suavizado","Errores Box-Jenkings calibrado.suavizado")
colnames(errores) <- c("ER","PFA","PTFA","RECM")
centros.radar(errores)

4G Trafico 2.descarga candidato 1

celda<-sqldf(sprintf("select `Fecha`,`Id.Celda`,`Trafico2.carga`,`Trafico2.Descarga` 
                           from datos_4g where `Id.Celda`= '%s' group by `Fecha`", as.character(as.list(celdas4g_candidatos[[5]][1]))))

celda.aprende<-celda[1:round(dim(celda)[1]*0.8),]
celda.test<-celda[as.numeric(round((dim(celda)[1])*0.8)+1):as.numeric(dim(celda)[1]),]
celda.aprende.serie<-ts(celda.aprende$Trafico2.Descarga,start = c(lubridate::year(celda.aprende$Fecha)[1],yday(celda.aprende$Fecha)[1]),frequency = 365)
ARIMA_NUMEROS<-paste(auto.arima(celda.aprende.serie))
ARIMA_NUMEROS<-str_extract_all(ARIMA_NUMEROS,"[[:digit:]]")
modelo<-arima(celda.aprende.serie,order = c(as.numeric(ARIMA_NUMEROS[[1]][1]),as.numeric(ARIMA_NUMEROS[[1]][2]),as.numeric(ARIMA_NUMEROS[[1]][3])))
pred.arima<-predict(modelo,n.ahead = dim(celda.test)[1])

er<-ER(pred.arima$pred,celda.test$Trafico2.Descarga)
pfa<-PFA(pred.arima$pred,celda.test$Trafico2.Descarga)
ptfa<-PTFA(pred.arima$pred,celda.test$Trafico2.Descarga)
recm<-RECM(pred.arima$pred,celda.test$Trafico2.Descarga)
err<-c(er,pfa,ptfa,recm)


celda.aprende<-celda[1:round(dim(celda)[1]*0.8),]
celda.test<-celda[as.numeric(round((dim(celda)[1])*0.8)+1):as.numeric(dim(celda)[1]),]
res<-spec.pgram(celda$Trafico2.Descarga, log = "no",plot = FALSE)
conteo<-0
for (a in 2:length(order(res$spec,res$freq,decreasing = TRUE))) {
  if(order(res$spec,res$freq,decreasing = TRUE)[a]>2 && conteo < 1){
    max<-res$freq[order(res$spec,res$freq,decreasing = TRUE)[a]]
    periodo<-365/max
    conteo=1
    break()
  }
}
ARIMA_NUMEROS<-calibrar.arima(celda.aprende$Trafico2.Descarga,celda.test$Trafico2.Descarga,periodo)
celda.aprende.serie<-ts(celda.aprende$Trafico2.Descarga,start = c(lubridate::year(celda.aprende$Fecha)[1],yday(celda.aprende$Fecha)[1]),frequency = 365)
tryCatch(modelo <- arima(celda.aprende.serie, order = c(ARIMA_NUMEROS$call$order[1],ARIMA_NUMEROS$call$order[2],ARIMA_NUMEROS$call$order[3]),
                         seasonal = list(order = c(ARIMA_NUMEROS$call$seasonal$order[1],ARIMA_NUMEROS$call$seasonal$order[2],ARIMA_NUMEROS$call$seasonal$order[3]),
                                         period = as.double(ARIMA_NUMEROS$call$seasonal$period))),
         finally = modelo <- arima(celda.aprende.serie, order = c(ARIMA_NUMEROS$call$order[1],ARIMA_NUMEROS$call$order[2],ARIMA_NUMEROS$call$order[3])))
pred.arima.calibrado <- predict(modelo, n.ahead = (as.numeric(dim(celda)[1])-as.numeric(round((dim(celda)[1])*0.8)+1))+1)
er2   <- ER(pred.arima.calibrado$pred, celda.test$Trafico2.Descarga)
pfa2  <- PFA(pred.arima.calibrado$pred,celda.test$Trafico2.Descarga)
ptfa2 <- PTFA(pred.arima.calibrado$pred,celda.test$Trafico2.Descarga)
recm2 <- RECM(pred.arima.calibrado$pred,celda.test$Trafico2.Descarga)
err2 <- c(er2, pfa2, ptfa2, recm2)



celda<-sqldf(sprintf("select `Fecha`,`Id.Celda`,`Trafico2.carga`,`Trafico2.Descarga` 
                           from datos_4g where `Id.Celda`= '%s' group by `Fecha`", as.character(as.list(celdas4g_candidatos[[5]][1]))))

rownames(celda)<-celda$Fecha
celda<-select(celda,-c(Fecha,Id.Celda))
celda<-suavizar.serie(celda,n=5)
celda.aprende<-celda[1:round(dim(celda)[1]*0.8),]
celda.test<-celda[as.numeric(round((dim(celda)[1])*0.8)+1):as.numeric(dim(celda)[1]),]
celda.aprende.serie<-ts(celda.aprende$Trafico2.Descarga,start = c(lubridate::year(rownames(celda.aprende))[1],yday(rownames(celda.aprende))[1]),frequency = 365)
ARIMA_NUMEROS<-paste(auto.arima(celda.aprende.serie))
ARIMA_NUMEROS<-str_extract_all(ARIMA_NUMEROS,"[[:digit:]]")
modelo<-arima(celda.aprende.serie,order = c(as.numeric(ARIMA_NUMEROS[[1]][1]),as.numeric(ARIMA_NUMEROS[[1]][2]),as.numeric(ARIMA_NUMEROS[[1]][3])))
pred.arima<-predict(modelo,n.ahead = dim(celda.test)[1])

er3<-ER(pred.arima$pred,celda.test$Trafico2.Descarga)
pfa3<-PFA(pred.arima$pred,celda.test$Trafico2.Descarga)
ptfa3<-PTFA(pred.arima$pred,celda.test$Trafico2.Descarga)
recm3<-RECM(pred.arima$pred,celda.test$Trafico2.Descarga)
err3<-c(er3,pfa3,ptfa3,recm3)


celda.aprende<-celda[1:round(dim(celda)[1]*0.8),]
celda.test<-celda[as.numeric(round((dim(celda)[1])*0.8)+1):as.numeric(dim(celda)[1]),]
res<-spec.pgram(celda$Trafico2.Descarga, log = "no",plot = FALSE)
conteo<-0
for (a in 2:length(order(res$spec,res$freq,decreasing = TRUE))) {
  if(order(res$spec,res$freq,decreasing = TRUE)[a]>2 && conteo < 1){
    max<-res$freq[order(res$spec,res$freq,decreasing = TRUE)[a]]
    periodo<-365/max
    conteo=1
    break()
  }
}
ARIMA_NUMEROS<-calibrar.arima(celda.aprende$Trafico2.Descarga,celda.test$Trafico2.Descarga,periodo)
celda.aprende.serie<-ts(celda.aprende$Trafico2.Descarga,start = c(lubridate::year(rownames(celda.aprende))[1],yday(rownames(celda.aprende))[1]),frequency = 365)
tryCatch(modelo <- arima(celda.aprende.serie, order = c(ARIMA_NUMEROS$call$order[1],ARIMA_NUMEROS$call$order[2],ARIMA_NUMEROS$call$order[3]),
                         seasonal = list(order = c(ARIMA_NUMEROS$call$seasonal$order[1],ARIMA_NUMEROS$call$seasonal$order[2],ARIMA_NUMEROS$call$seasonal$order[3]),
                                         period = as.double(ARIMA_NUMEROS$call$seasonal$period))),
         finally = modelo <- arima(celda.aprende.serie, order = c(ARIMA_NUMEROS$call$order[1],ARIMA_NUMEROS$call$order[2],ARIMA_NUMEROS$call$order[3])))
pred.arima.calibrado <- predict(modelo, n.ahead = (as.numeric(dim(celda)[1])-as.numeric(round((dim(celda)[1])*0.8)+1))+1)
er4   <- ER(pred.arima.calibrado$pred, celda.test$Trafico2.Descarga)
pfa4  <- PFA(pred.arima.calibrado$pred,celda.test$Trafico2.Descarga)
ptfa4 <- PTFA(pred.arima.calibrado$pred,celda.test$Trafico2.Descarga)
recm4 <- RECM(pred.arima.calibrado$pred,celda.test$Trafico2.Descarga)
err4 <- c(er4, pfa4, ptfa4, recm4)

errores <- rbind(err,err2,err3,err4)
rownames(errores) <- c("Errores Box-Jenkings no calibrado","Errores Box-Jenkings calibrado","Errores Box-Jenkings no calibrado.suavizado","Errores Box-Jenkings calibrado.suavizado")
colnames(errores) <- c("ER","PFA","PTFA","RECM")
centros.radar(errores)

Fase 5

Fase 5

1.Evaluar los resultados

Modelos actualizados

3GBox-Jenkings NO calibrado suavizado.Trafico.1

celda<-sqldf(sprintf("select `Accesos.a.menos.de.500.m`,`Accesibilidad.en.datos`,`Accesibilidad.exitosa`,`Fecha`,`Id.Celda`,`Trafico.1`,`Trafico.2`,`Usuarios.Carga`,`Usuarios.descarga`
                           from datos_3g where `Id.Celda`= '%s' group by `Fecha`", as.character(as.list(celdas3g_candidatos[[1]][1]))))

Fecha<-celda$Fecha
rownames(celda)<-celda$Fecha
celda<-select(celda,-c(Fecha,Id.Celda))
celda<-suavizar.serie(celda,n=3)
serie.celda<-ts(celda$Trafico.1,start = c(lubridate::year(Fecha)[1],yday(Fecha)[1]),frequency = 365)
celda.accesos<-ts(celda$Accesos.a.menos.de.500.m,start = c(lubridate::year(Fecha)[1],yday(Fecha)[1]),frequency = 365)
celda.accesibilidad<-ts(celda$Accesibilidad.exitosa,start = c(lubridate::year(Fecha)[1],yday(Fecha)[1]),frequency = 365)


res<-spec.pgram(serie.celda, log = "no",plot = FALSE)
order(res$spec,res$freq,decreasing = TRUE) 
##  [1]  1  2  7  4 27  8  3  5 12  6 14 19  9 28 18 29 11 16 26 22 24 30 34
## [24] 55 31 25 82 21 13 40 10 47 38 41 83 23 36 39 43 20 37 84 44 35 33 42
## [47] 48 88 49 54 95 51 89 15 81 52 77 80 87 32 74 85 17 53 78 57 91 79 92
## [70] 75 59 45 94 50 60 46 61 93 90 62 69 58 76 70 72 86 65 63 66 96 68 73
## [93] 64 67 56 71
max1<-res$freq[4]
periodo1 <- 365/max1

auto.arima(serie.celda)
## Series: serie.celda 
## ARIMA(2,1,2) 
## 
## Coefficients:
##          ar1      ar2      ma1     ma2
##       1.2191  -0.9775  -1.0054  0.8119
## s.e.  0.0241   0.0212   0.0623  0.0648
## 
## sigma^2 estimated as 39.74:  log likelihood=-595.95
## AIC=1201.9   AICc=1202.24   BIC=1217.95
modelo <- arima(serie.celda, order = c(2, 1, 2), seasonal = list(order=c(1, 1, 1), period = periodo1))
pred <- predict(modelo, n.ahead = 30)

prediccion <- pred$pred
LimInf <- prediccion - pred$se
LimSup <- prediccion + pred$se

fechas.original <- as.Date(Fecha)
ultima.fecha.original <- fechas.original[length(fechas.original)]
fecha.pred.inicial <- ultima.fecha.original + days(1)
fecha.pred.final   <- ultima.fecha.original + days(30)
fechas.pred <- seq(fecha.pred.inicial, fecha.pred.final, by = "day")

todas.series <- cbind(
  valor      = xts(serie.celda, order.by = fechas.original),
  LimInf     = xts(LimInf, order.by = fechas.pred),
  Pronostico = xts(prediccion, order.by = fechas.pred),
  LimSup     = xts(LimSup, order.by = fechas.pred))

dy_graph <- list(
  dygraph(xts(celda.accesos,order.by = fechas.original),group = "grafico",main="Cantidad de accesos", ylab = "Cantidad"),
  dygraph(todas.series,group = "grafico", main = paste("Predicción de tráfico en celda",as.character(celdas3g_candidatos[[1]][1]),sep = " "), ylab = "Valor Tráfico 1 (Hora/Voz)") %>%
    dySeries(c("LimInf","Pronostico","LimSup"), label = "Open") %>%
    dyRangeSelector(height = 20, strokeColor = "") %>%  
    dyOptions(axisLineColor = "navy", gridLineColor = "lightblue"),
  dygraph(xts(celda.accesibilidad,order.by = fechas.original),group = "grafico",main="Accesibilidad exitosa", ylab = "%")
)
htmltools::browsable(htmltools::tagList(dy_graph))
Cantidad de accesos
Cantidad
2000
2500
3000
3500
4000
4500
5000
5500
6000
6500
Mar 2019
Apr 2019
May 2019
Jun 2019
Jul 2019
Aug 2019
Predicción de tráfico en celda W3005A1
Valor Tráfico 1 (Hora/Voz)
valor
Open
60
80
100
120
140
160
180
200
Mar 2019
Apr 2019
May 2019
Jun 2019
Jul 2019
Aug 2019
Accesibilidad exitosa
%
95.5
96
96.5
97
97.5
98
98.5
Mar 2019
Apr 2019
May 2019
Jun 2019
Jul 2019
Aug 2019

3GBox-Jenkings calibrado suavizado.Trafico.2

celda<-sqldf(sprintf("select `Usuarios.descarga`,`Accesibilidad.en.datos`,`Accesibilidad.exitosa`,`Fecha`,`Id.Celda`,`Trafico.1`,`Trafico.2` 
                           from datos_3g where `Id.Celda`= '%s' group by `Fecha`", as.character(as.list(celdas3g_candidatos[[1]][1]))))


Fecha<-celda$Fecha
rownames(celda)<-celda$Fecha
celda<-select(celda,-c(Fecha,Id.Celda))
celda<-suavizar.serie(celda,n=3)

celda.aprende<-celda[1:round(dim(celda)[1]*0.8),]
celda.test<-celda[as.numeric(round((dim(celda)[1])*0.8)+1):as.numeric(dim(celda)[1]),]
serie.usuario.descarga<-ts(celda$Usuarios.descarga,start = c(lubridate::year(Fecha)[1],yday(Fecha)[1]),frequency = 365)
serie.accesibilidad.datos<-ts(celda$Accesibilidad.en.datos,start = c(lubridate::year(Fecha)[1],yday(Fecha)[1]),frequency = 365)
serie.accesibilidad<-ts(celda$Accesibilidad.exitosa,start = c(lubridate::year(Fecha)[1],yday(Fecha)[1]),frequency = 365)


celda<-ts(celda$Trafico.2,start = c(lubridate::year(Fecha)[1],yday(Fecha)[1]),frequency = 365)
res<-spec.pgram(celda, log = "no",plot = FALSE)
order(res$spec,res$freq,decreasing = TRUE)
##  [1]  2  5  6  1  7 11 12 13  9 27 38  4 28 10 23 37 17 14 19 24 26 29  3
## [24]  8 40 50 55 41 34 33 18 21 16 20 39 35 32 30 15 43 93 46 36 82 49 81
## [47] 83 84 57 91 56 42 45 78 53 31 51 48 77 71 54 25 85 94 80 92 47 58 74
## [70] 88 72 60 52 76 59 73 89 69 95 86 96 75 90 87 22 70 68 62 44 79 63 64
## [93] 67 65 66 61
max<-res$freq[13]
periodo<-round(365/max)
 
ARIMA_NUMEROS<-calibrar.arima(celda.aprende$Trafico.2,celda.test$Trafico.2,periodo)
celda.aprende.serie<-ts(celda.aprende$Trafico.2,start = c(lubridate::year(rownames(celda.aprende))[1],yday(rownames(celda.aprende))[1]),frequency = 365)
modelo <- arima(celda.aprende.serie, 
                order = c(as.integer(ARIMA_NUMEROS$call$order[1]),as.integer(ARIMA_NUMEROS$call$order[2]),as.integer(ARIMA_NUMEROS$call$order[3])),
                seasonal = list(order = c(as.integer(ARIMA_NUMEROS$call$seasonal$order[1]),as.integer(ARIMA_NUMEROS$call$seasonal$order[2]),as.integer(ARIMA_NUMEROS$call$seasonal$order[3])),
                                period = as.double(ARIMA_NUMEROS$call$seasonal$period)))
pred.arima.calibrado <- predict(modelo, n.ahead = (as.numeric(length(celda)[1])-as.numeric(round((length(celda)[1])*0.8)+7)))

prediccion <- pred.arima.calibrado$pred
LimInf <- prediccion - pred.arima.calibrado$se
LimSup <- prediccion + pred.arima.calibrado$se

fechas.original <- Fecha
ultima.fecha.original <- fechas.original[length(fechas.original)]
fecha.pred.inicial <- ultima.fecha.original + days(1)
fecha.pred.final   <- ultima.fecha.original + days(30)
fechas.pred <- seq(fecha.pred.inicial, fecha.pred.final, by = "day")


todas.series <- cbind(
  valor      = xts(celda, order.by = fechas.original),
  LimInf     = xts(LimInf, order.by = fechas.pred),
  Pronostico = xts(prediccion, order.by = fechas.pred),
  LimSup     = xts(LimSup, order.by = fechas.pred))

dy_graph <- list(
  dygraph(xts(serie.accesibilidad.datos,order.by = fechas.original),group = "grafico",main="Accesibilidad de datos", ylab = "%"),
  dygraph(xts(serie.accesibilidad,order.by = fechas.original),group = "grafico",main="Accesibilidad exitosa", ylab = "%"),
  dygraph(todas.series,group = "grafico", main = paste("Predicción de tráfico en celda",as.character(celdas3g_candidatos[[1]][1]),sep = " "), ylab = "Valor Tráfico 2 (Kbps)") %>%
    dySeries(c("LimInf","Pronostico","LimSup"), label = "Open") %>%
    dyRangeSelector(height = 20, strokeColor = "") %>%  
    dyOptions(axisLineColor = "navy", gridLineColor = "lightblue"),
  dygraph(xts(serie.usuario.descarga,order.by = fechas.original),group = "grafico",main="Cantidad de usuarios en carga", ylab = "Cantidad de usuarios")
)
htmltools::browsable(htmltools::tagList(dy_graph))
Accesibilidad de datos
%
94.6
94.8
95
95.2
95.4
95.6
95.8
96
96.2
96.4
96.6
96.8
97
97.2
Mar 2019
Apr 2019
May 2019
Jun 2019
Jul 2019
Aug 2019
Accesibilidad exitosa
%
95.5
96
96.5
97
97.5
98
98.5
Mar 2019
Apr 2019
May 2019
Jun 2019
Jul 2019
Aug 2019
Predicción de tráfico en celda W3005A1
Valor Tráfico 2 (Kbps)
valor
Open
800
900
1000
1100
1200
1300
1400
1500
Mar 2019
Apr 2019
May 2019
Jun 2019
Jul 2019
Aug 2019
Cantidad de usuarios en carga
Cantidad de usuarios
20
21
22
23
24
25
26
27
28
29
30
31
32
33
Mar 2019
Apr 2019
May 2019
Jun 2019
Jul 2019
Aug 2019

4GBox-Jenkings NO calibrado suavizaso.Trafico2.carga

celda<-sqldf(sprintf("select `Accesos.de.0m.a.624m`,`Uso.de.recursos.UL`,`Cantidad.de.usuarios`,`Fecha`,`Id.Celda`,`Trafico2.carga`,`Trafico2.Descarga` 
                           from datos_4g where `Id.Celda`= '%s' group by `Fecha`", as.character(as.list(celdas4g_candidatos[[5]][1]))))

Fecha<-celda$Fecha
rownames(celda)<-celda$Fecha
celda<-select(celda,-c(Fecha,Id.Celda))
celda<-suavizar.serie(celda,n=3)
serie.celda<-ts(celda$Trafico2.carga,start = c(lubridate::year(Fecha)[1],yday(Fecha)[1]),frequency = 365)
serie.cantidad<-ts(celda$Cantidad.de.usuarios,start = c(lubridate::year(Fecha)[1],yday(Fecha)[1]),frequency = 365)
serie.uso.recursos<-ts(celda$Uso.de.recursos.UL,start = c(lubridate::year(Fecha)[1],yday(Fecha)[1]),frequency = 365)
serie.accesos<-ts(celda$Accesos.de.0m.a.624m,start = c(lubridate::year(Fecha)[1],yday(Fecha)[1]),frequency = 365)


res<-spec.pgram(serie.celda, log = "no",plot = FALSE)
order(res$spec,res$freq,decreasing = TRUE) 
##  [1]  1  2 28 27  3  6  7 19  4 11 25 16 18 17  9  5 39 23 20 12  8 30 13
## [24] 55 32 40 33 37 41 24 26 35 34 46 43 96 85 92 14 38 50 47 42 54 95 94
## [47] 93 31 49 10 15 86 36 90 80 51 79 29 91 81 45 76 77 82 21 48 22 84 56
## [70] 78 53 87 57 74 71 75 44 61 89 73 60 69 83 52 67 70 68 66 62 63 58 88
## [93] 65 64 59 72
max1<-res$freq[28]
periodo1 <- 365/max1

auto.arima(serie.celda)
## Series: serie.celda 
## ARIMA(3,1,2) with drift 
## 
## Coefficients:
##          ar1     ar2      ar3     ma1      ma2    drift
##       0.2547  0.1901  -0.6268  0.0161  -0.2843  -0.0053
## s.e.  0.0953  0.0975   0.0619  0.1207   0.1153   0.0074
## 
## sigma^2 estimated as 0.02654:  log likelihood=74.7
## AIC=-135.41   AICc=-134.77   BIC=-112.94
modelo <- arima(serie.celda, order = c(3, 1, 2), seasonal = list(order=c(3, 3, 3), period = periodo1))
pred <- predict(modelo, n.ahead = 30)

prediccion <- pred$pred
LimInf <- prediccion - pred$se
LimSup <- prediccion + pred$se

fechas.original <- as.Date(Fecha)
ultima.fecha.original <- fechas.original[length(fechas.original)]
fecha.pred.inicial <- ultima.fecha.original + days(1)
fecha.pred.final   <- ultima.fecha.original + days(30)
fechas.pred <- seq(fecha.pred.inicial, fecha.pred.final, by = "day")

todas.series <- cbind(
  valor      = xts(serie.celda, order.by = fechas.original),
  LimInf     = xts(LimInf, order.by = fechas.pred),
  Pronostico = xts(prediccion, order.by = fechas.pred),
  LimSup     = xts(LimSup, order.by = fechas.pred))

dy_graph <- list(
  dygraph(xts(serie.uso.recursos,order.by = fechas.original),group = "grafico",main="Uso de recursos", ylab = "%"),
  dygraph(xts(serie.accesos,order.by = fechas.original),group = "grafico",main="Accesos 0 a 620m", ylab = "Cantidad de accesos"),
  dygraph(todas.series,group = "grafico", main = paste("Predicción de tráfico en celda",as.character(celdas4g_candidatos[[5]][1]),sep = " "), ylab = "Valor Tráfico 2 Carga de datos") %>%
    dySeries(c("LimInf","Pronostico","LimSup"), label = "Open") %>%
    dyRangeSelector(height = 20, strokeColor = "") %>%  
    dyOptions(axisLineColor = "navy", gridLineColor = "lightblue"),
  dygraph(xts(serie.cantidad,order.by = fechas.original),group = "grafico",main="Cantidad de usuarios en carga", ylab = "Cantidad de usuarios")
)
htmltools::browsable(htmltools::tagList(dy_graph))
Uso de recursos
%
14
16
18
20
22
24
26
28
30
Mar 2019
Apr 2019
May 2019
Jun 2019
Jul 2019
Aug 2019
Accesos 0 a 620m
Cantidad de accesos
200000
250000
300000
350000
400000
450000
500000
550000
600000
650000
Mar 2019
Apr 2019
May 2019
Jun 2019
Jul 2019
Aug 2019
Predicción de tráfico en celda L07201080A2
Valor Tráfico 2 Carga de datos
valor
Open
1.8
2
2.2
2.4
2.6
2.8
3
3.2
3.4
3.6
3.8
4
4.2
Mar 2019
Apr 2019
May 2019
Jun 2019
Jul 2019
Aug 2019
Cantidad de usuarios en carga
Cantidad de usuarios
150
200
250
300
350
400
Mar 2019
Apr 2019
May 2019
Jun 2019
Jul 2019
Aug 2019

4GBox-Jenkings calibrado suavizado Trafico2.descarga

celda<-sqldf(sprintf("select `Fecha`,`Id.Celda`,`Trafico2.carga`,`Trafico2.Descarga`,`Cantidad.de.usuarios`,`Uso.de.recursos.DL`,`Accesos.de.0m.a.624m` 
                           from datos_4g where `Id.Celda`= '%s' group by `Fecha`", as.character(as.list(celdas4g_candidatos[[5]][1]))))


Fecha<-celda$Fecha
rownames(celda)<-celda$Fecha
celda<-select(celda,-c(Fecha,Id.Celda))
celda<-suavizar.serie(celda,n=3)

celda.aprende<-celda[1:round(dim(celda)[1]*0.8),]
celda.test<-celda[as.numeric(round((dim(celda)[1])*0.8)+1):as.numeric(dim(celda)[1]),]

serie.uso.recursos<-ts(celda$Uso.de.recursos.DL,start = c(lubridate::year(Fecha)[1],yday(Fecha)[1]),frequency = 365)
serie.accesos<-ts(celda$Accesos.de.0m.a.624m,start = c(lubridate::year(Fecha)[1],yday(Fecha)[1]),frequency = 365)
serie.cantidad<-ts(celda$Cantidad.de.usuarios,start = c(lubridate::year(Fecha)[1],yday(Fecha)[1]),frequency = 365)
celda<-ts(celda$Trafico2.Descarga,start = c(lubridate::year(Fecha)[1],yday(Fecha)[1]),frequency = 365)
res<-spec.pgram(celda, log = "no",plot = FALSE)
order(res$spec,res$freq,decreasing = TRUE)
##  [1] 27 28  6  1 25  3  7 19 30 10  2 55  9 12 11 13 29 17  5 22 16 23 37
## [24] 18 38 36 32 21  4 82 54 43  8 47 50 39 24 14 33 41 95 20 34 56 42 45
## [47] 46 40 92 44 77 90 48 85 83 51 75 79 86 93 80 87 26 88 49 72 52 89 58
## [70] 84 59 53 69 91 60 31 71 76 81 57 15 96 68 94 73 74 78 35 70 66 62 65
## [93] 61 67 63 64
max<-res$freq[3]
periodo<-round(365/max)
 
ARIMA_NUMEROS<-calibrar.arima(celda.aprende$Trafico2.Descarga,celda.test$Trafico2.Descarga,periodo)
celda.aprende.serie<-ts(celda.aprende$Trafico2.Descarga,start = c(lubridate::year(rownames(celda.aprende))[1],yday(rownames(celda.aprende))[1]),frequency = 365)
modelo <- arima(celda.aprende.serie, 
                order = c(as.integer(ARIMA_NUMEROS$call$order[1]),as.integer(ARIMA_NUMEROS$call$order[2]),as.integer(ARIMA_NUMEROS$call$order[3])),
                seasonal = list(order = c(as.integer(ARIMA_NUMEROS$call$seasonal$order[1]),as.integer(ARIMA_NUMEROS$call$seasonal$order[2]),as.integer(ARIMA_NUMEROS$call$seasonal$order[3])),
                                period = as.double(ARIMA_NUMEROS$call$seasonal$period)))
pred.arima.calibrado <- predict(modelo, n.ahead = (as.numeric(length(celda)[1])-as.numeric(round((length(celda)[1])*0.8)+7)))

prediccion <- pred.arima.calibrado$pred
LimInf <- prediccion - pred.arima.calibrado$se
LimSup <- prediccion + pred.arima.calibrado$se

fechas.original <- Fecha
ultima.fecha.original <- fechas.original[length(fechas.original)]
fecha.pred.inicial <- ultima.fecha.original + days(1)
fecha.pred.final   <- ultima.fecha.original + days(30)
fechas.pred <- seq(fecha.pred.inicial, fecha.pred.final, by = "day")


todas.series <- cbind(
  valor      = xts(celda, order.by = fechas.original),
  LimInf     = xts(LimInf, order.by = fechas.pred),
  Pronostico = xts(prediccion, order.by = fechas.pred),
  LimSup     = xts(LimSup, order.by = fechas.pred))

dy_graph <- list(
  dygraph(xts(serie.uso.recursos,order.by = fechas.original),group = "grafico",main="Uso de recursos", ylab = "%"),
  dygraph(xts(serie.accesos,order.by = fechas.original),group = "grafico",main="Accesos 0 a 620m", ylab = "Cantidad de accesos"),
  dygraph(todas.series,group = "grafico", main = paste("Predicción de tráfico en celda",as.character(celdas4g_candidatos[[5]][1]),sep = " "), ylab = "Valor Tráfico 2 descarga de datos") %>%
    dySeries(c("LimInf","Pronostico","LimSup"), label = "Open") %>%
    dyRangeSelector(height = 20, strokeColor = "") %>%  
    dyOptions(axisLineColor = "navy", gridLineColor = "lightblue"),
  dygraph(xts(serie.cantidad,order.by = fechas.original),group = "grafico",main="Cantidad de usuarios en carga", ylab = "Cantidad de usuarios")
)
htmltools::browsable(htmltools::tagList(dy_graph))
Uso de recursos
%
10
15
20
25
30
35
40
Mar 2019
Apr 2019
May 2019
Jun 2019
Jul 2019
Aug 2019
Accesos 0 a 620m
Cantidad de accesos
200000
250000
300000
350000
400000
450000
500000
550000
600000
650000
Mar 2019
Apr 2019
May 2019
Jun 2019
Jul 2019
Aug 2019
Predicción de tráfico en celda L07201080A2
Valor Tráfico 2 descarga de datos
valor
Open
19
20
21
22
23
24
25
26
27
28
Mar 2019
Apr 2019
May 2019
Jun 2019
Jul 2019
Aug 2019
Cantidad de usuarios en carga
Cantidad de usuarios
150
200
250
300
350
400
Mar 2019
Apr 2019
May 2019
Jun 2019
Jul 2019
Aug 2019